Ignore:
Timestamp:
Jul 22, 2024, 9:29:09 PM (2 months ago)
Author:
abarral
Message:

Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90
Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad
Create lmdz_yoerad.f90
(lint) Remove "!" on otherwise empty line

Location:
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust
Files:
16 edited
14 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/bcscav_spl.F

    r4593 r5099  
    3434! fluxes are defined on klev levels only.
    3535! NHL
    36 !
     36
    3737      flxr_aux(:,klev+1)=0.0
    3838      flxs_aux(:,klev+1)=0.0
    3939      flxr_aux(:,1:klev)=flxr(:,:)
    4040      flxs_aux(:,1:klev)=flxs(:,:)
    41 !
     41
    4242      DO k=1, klev
    4343      DO i=1, klon

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/checkmass.F90

    r4593 r5099  
    22  USE dimphy
    33USE geometry_mod , ONLY:cell_area
     4  USE lmdz_yomcst
    45  IMPLICIT NONE
    56
    6   INCLUDE "YOMCST.h"
    77
    88! Entrees

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/chem_spla.h

    r2630 r5099  
    1 !
     1
    22! $Header$
    3 !
    43
    54      INTEGER ss_bins

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/cltrac_spl.f90

    r5098 r5099  
    1       SUBROUTINE cltrac_spl(dtime,coef,yu1,yv1,t,tr,
    2      .                     flux,paprs,pplay,d_tr)
     1SUBROUTINE cltrac_spl(dtime, coef, yu1, yv1, t, tr, &
     2        flux, paprs, pplay, d_tr)
    33
    4       USE dimphy
    5       IMPLICIT none
    6 c======================================================================
    7 c Auteur(s): O. Boucher (LOA/LMD) date: 19961127
    8 c            inspire de clvent
    9 c Objet: diffusion verticale de traceurs avec flux fixe a la surface
    10 c        ou/et flux du type c-drag
    11 c======================================================================
    12 c Arguments:
    13 c dtime----input-R- intervalle du temps (en second)
    14 c coef-----input-R- le coefficient d'echange (m**2/s) l>1
    15 c yu1------input-R- le vent dans le 1iere couche
    16 c yv1------input-R- le vent dans le 1iere couche
    17 c t--------input-R- temperature (K)
    18 c tr-------input-R- la q. de traceurs
    19 c flux-----input-R- le flux de traceurs a la surface
    20 c paprs----input-R- pression a inter-couche (Pa)
    21 c pplay----input-R- pression au milieu de couche (Pa)
    22 c delp-----input-R- epaisseur de couche (Pa)
    23 c cdrag----input-R- cdrag pour le flux de surface (non active)
    24 c tr0------input-R- traceurs a la surface ou dans l'ocean (non active)
    25 c d_tr-----output-R- le changement de tr
    26 c flux_tr--output-R- flux de tr
    27 c======================================================================
    28       INCLUDE "dimensions.h"
    29       REAL dtime
    30       REAL coef(klon,klev)
    31       REAL yu1(klon), yv1(klon)
    32       REAL t(klon,klev), tr(klon,klev)
    33       REAL paprs(klon,klev+1), pplay(klon,klev), delp(klon,klev)
    34       REAL d_tr(klon,klev)
    35       REAL flux(klon), cdrag(klon), tr0(klon)
    36 c      REAL flux_tr(klon,klev)
    37 c======================================================================
    38       INCLUDE "YOMCST.h"
    39 c======================================================================
    40       INTEGER i, k
    41       REAL zx_ctr(klon,2:klev)
    42       REAL zx_dtr(klon,2:klev)
    43       REAL zx_buf(klon)
    44       REAL zx_coef(klon,klev)
    45       REAL local_tr(klon,klev)
    46       REAL zx_alf1(klon), zx_alf2(klon), zx_flux(klon)
    47 c======================================================================
    48 c CHECKING VALUES
    49 !      print *,'CHECKING VALUES IN CLTRAC (INI)'
    50 !      print *,'d_tr = ',sum(d_tr),MINVAL(d_tr),MAXVAL(d_tr)
    51 !      print *,'flux = ',sum(flux),MINVAL(flux),MAXVAL(flux)
    52 !      print *,'tr = ',sum(tr),MINVAL(tr),MAXVAL(tr)
    53 c======================================================================
    54       DO k = 1, klev
    55       DO i = 1, klon
    56          local_tr(i,k) = tr(i,k)
    57          delp(i,k) = paprs(i,k)-paprs(i,k+1)
    58       ENDDO
    59       ENDDO
    60 c======================================================================
    61       DO i = 1, klon
    62          zx_alf1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
    63          zx_alf2(i) = 1.0 - zx_alf1(i)
    64          zx_flux(i) =  -flux(i)*dtime*RG
    65 c--pour le moment le flux est prescrit
    66          cdrag(i) = 0.0
    67 c        cdrag(i) =  coef(i,1) * (1.0+SQRT(yu1(i)**2+yv1(i)**2))
    68 c    .                * pplay(i,1)/(RD*t(i,1))
    69          tr0(i) = 0.0
    70          zx_coef(i,1) = cdrag(i)*dtime*RG
    71       ENDDO
    72 c======================================================================
    73       DO k = 2, klev
    74       DO i = 1, klon
    75          zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))
    76      .                  *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2
    77          zx_coef(i,k) = zx_coef(i,k)*dtime*RG
    78       ENDDO
    79       ENDDO
    80 c======================================================================
    81       DO i = 1, klon
    82          zx_buf(i) = delp(i,1) + zx_coef(i,1)*zx_alf1(i) + zx_coef(i,2)
    83          zx_ctr(i,2) = (local_tr(i,1)*delp(i,1)+
    84      .                  zx_coef(i,1)*tr0(i)-zx_flux(i))/zx_buf(i)
    85          zx_dtr(i,2) = (zx_coef(i,2)-zx_alf2(i)*zx_coef(i,1)) /
    86      .                  zx_buf(i)
    87       ENDDO
    88 c
    89       DO k = 3, klev
    90       DO i = 1, klon
    91          zx_buf(i) = delp(i,k-1) + zx_coef(i,k)
    92      .                  + zx_coef(i,k-1)*(1.-zx_dtr(i,k-1))
    93          zx_ctr(i,k) = (local_tr(i,k-1)*delp(i,k-1)
    94      .                  +zx_coef(i,k-1)*zx_ctr(i,k-1) )/zx_buf(i)
    95          zx_dtr(i,k) = zx_coef(i,k)/zx_buf(i)
    96       ENDDO
    97       ENDDO
    98       DO i = 1, klon
    99          local_tr(i,klev) = ( local_tr(i,klev)*delp(i,klev)
    100      .                        +zx_coef(i,klev)*zx_ctr(i,klev) )
    101      .                   / ( delp(i,klev) + zx_coef(i,klev)
    102      .                       -zx_coef(i,klev)*zx_dtr(i,klev) )
    103       ENDDO
    104       DO k = klev-1, 1, -1
    105       DO i = 1, klon
    106          local_tr(i,k) = zx_ctr(i,k+1) + zx_dtr(i,k+1)*local_tr(i,k+1)
    107       ENDDO
    108       ENDDO
    109 c======================================================================
    110 !      print *,'CHECKING VALUES IN CLTRAC (FIN)'
    111 !      print *,'local_tr = ',sum(local_tr),MINVAL(local_tr),
    112 !    .                                    MAXVAL(local_tr)
    113 !      print *,'zx_ctr = ',sum(zx_ctr),MINVAL(zx_ctr),MAXVAL(zx_ctr)
    114 !      print *,'zx_dtr = ',sum(zx_dtr),MINVAL(zx_dtr),MAXVAL(zx_dtr)
    115 !      print *,'tr = ',sum(tr),MINVAL(tr),MAXVAL(tr)
    116 c======================================================================
    117 c== flux_tr est le flux de traceur (positif vers bas)
    118 c      DO i = 1, klon
    119 c         flux_tr(i,1) = zx_coef(i,1)/(RG*dtime)
    120 c      ENDDO
    121 c      DO k = 2, klev
    122 c      DO i = 1, klon
    123 c         flux_tr(i,k) = zx_coef(i,k)/(RG*dtime)
    124 c    .               * (local_tr(i,k)-local_tr(i,k-1))
    125 c      ENDDO
    126 c      ENDDO
    127 c======================================================================
    128       DO k = 1, klev
    129       DO i = 1, klon
    130          d_tr(i,k) = local_tr(i,k) - tr(i,k)
    131       ENDDO
    132       ENDDO
    133 !      print *,'CHECKING VALUES IN CLTRAC (END)'
    134 !      print *,'d_tr = ',sum(d_tr),MINVAL(d_tr),MAXVAL(d_tr)
    135 c
    136       RETURN
    137       END
     4  USE dimphy
     5  IMPLICIT none
     6  !======================================================================
     7  ! Auteur(s): O. Boucher (LOA/LMD) date: 19961127
     8  ! inspire de clvent
     9  ! Objet: diffusion verticale de traceurs avec flux fixe a la surface
     10  ! ou/et flux du type c-drag
     11  !======================================================================
     12  ! Arguments:
     13  ! dtime----input-R- intervalle du temps (en second)
     14  ! coef-----input-R- le coefficient d'echange (m**2/s) l>1
     15  ! yu1------input-R- le vent dans le 1iere couche
     16  ! yv1------input-R- le vent dans le 1iere couche
     17  ! t--------input-R- temperature (K)
     18  ! tr-------input-R- la q. de traceurs
     19  ! flux-----input-R- le flux de traceurs a la surface
     20  ! paprs----input-R- pression a inter-couche (Pa)
     21  ! pplay----input-R- pression au milieu de couche (Pa)
     22  ! delp-----input-R- epaisseur de couche (Pa)
     23  ! cdrag----input-R- cdrag pour le flux de surface (non active)
     24  ! tr0------input-R- traceurs a la surface ou dans l'ocean (non active)
     25  ! d_tr-----output-R- le changement de tr
     26  ! flux_tr--output-R- flux de tr
     27  !======================================================================
     28  INCLUDE "dimensions.h"
     29  REAL :: dtime
     30  REAL :: coef(klon, klev)
     31  REAL :: yu1(klon), yv1(klon)
     32  REAL :: t(klon, klev), tr(klon, klev)
     33  REAL :: paprs(klon, klev + 1), pplay(klon, klev), delp(klon, klev)
     34  REAL :: d_tr(klon, klev)
     35  REAL :: flux(klon), cdrag(klon), tr0(klon)
     36  ! REAL flux_tr(klon,klev)
     37  !======================================================================
     38  INCLUDE "YOMCST.h"
     39  !======================================================================
     40  INTEGER :: i, k
     41  REAL :: zx_ctr(klon, 2:klev)
     42  REAL :: zx_dtr(klon, 2:klev)
     43  REAL :: zx_buf(klon)
     44  REAL :: zx_coef(klon, klev)
     45  REAL :: local_tr(klon, klev)
     46  REAL :: zx_alf1(klon), zx_alf2(klon), zx_flux(klon)
     47  !======================================================================
     48  ! CHECKING VALUES
     49  ! print *,'CHECKING VALUES IN CLTRAC (INI)'
     50  ! print *,'d_tr = ',sum(d_tr),MINVAL(d_tr),MAXVAL(d_tr)
     51  ! print *,'flux = ',sum(flux),MINVAL(flux),MAXVAL(flux)
     52  ! print *,'tr = ',sum(tr),MINVAL(tr),MAXVAL(tr)
     53  !======================================================================
     54  DO k = 1, klev
     55    DO i = 1, klon
     56      local_tr(i, k) = tr(i, k)
     57      delp(i, k) = paprs(i, k) - paprs(i, k + 1)
     58    ENDDO
     59  ENDDO
     60  !======================================================================
     61  DO i = 1, klon
     62    zx_alf1(i) = (paprs(i, 1) - pplay(i, 2)) / (pplay(i, 1) - pplay(i, 2))
     63    zx_alf2(i) = 1.0 - zx_alf1(i)
     64    zx_flux(i) = -flux(i) * dtime * RG
     65    !--pour le moment le flux est prescrit
     66    cdrag(i) = 0.0
     67    ! cdrag(i) =  coef(i,1) * (1.0+SQRT(yu1(i)**2+yv1(i)**2))
     68    ! .                * pplay(i,1)/(RD*t(i,1))
     69    tr0(i) = 0.0
     70    zx_coef(i, 1) = cdrag(i) * dtime * RG
     71  ENDDO
     72  !======================================================================
     73  DO k = 2, klev
     74    DO i = 1, klon
     75      zx_coef(i, k) = coef(i, k) * RG / (pplay(i, k - 1) - pplay(i, k)) &
     76              * (paprs(i, k) * 2 / (t(i, k) + t(i, k - 1)) / RD)**2
     77      zx_coef(i, k) = zx_coef(i, k) * dtime * RG
     78    ENDDO
     79  ENDDO
     80  !======================================================================
     81  DO i = 1, klon
     82    zx_buf(i) = delp(i, 1) + zx_coef(i, 1) * zx_alf1(i) + zx_coef(i, 2)
     83    zx_ctr(i, 2) = (local_tr(i, 1) * delp(i, 1) + &
     84            zx_coef(i, 1) * tr0(i) - zx_flux(i)) / zx_buf(i)
     85    zx_dtr(i, 2) = (zx_coef(i, 2) - zx_alf2(i) * zx_coef(i, 1)) / &
     86            zx_buf(i)
     87  ENDDO
     88
     89  DO k = 3, klev
     90    DO i = 1, klon
     91      zx_buf(i) = delp(i, k - 1) + zx_coef(i, k) &
     92              + zx_coef(i, k - 1) * (1. - zx_dtr(i, k - 1))
     93      zx_ctr(i, k) = (local_tr(i, k - 1) * delp(i, k - 1) &
     94              + zx_coef(i, k - 1) * zx_ctr(i, k - 1)) / zx_buf(i)
     95      zx_dtr(i, k) = zx_coef(i, k) / zx_buf(i)
     96    ENDDO
     97  ENDDO
     98  DO i = 1, klon
     99    local_tr(i, klev) = (local_tr(i, klev) * delp(i, klev) &
     100            + zx_coef(i, klev) * zx_ctr(i, klev)) &
     101            / (delp(i, klev) + zx_coef(i, klev) &
     102                    - zx_coef(i, klev) * zx_dtr(i, klev))
     103  ENDDO
     104  DO k = klev - 1, 1, -1
     105    DO i = 1, klon
     106      local_tr(i, k) = zx_ctr(i, k + 1) + zx_dtr(i, k + 1) * local_tr(i, k + 1)
     107    ENDDO
     108  ENDDO
     109  !======================================================================
     110  ! print *,'CHECKING VALUES IN CLTRAC (FIN)'
     111  ! print *,'local_tr = ',sum(local_tr),MINVAL(local_tr),
     112  ! .                                    MAXVAL(local_tr)
     113  !  print *,'zx_ctr = ',sum(zx_ctr),MINVAL(zx_ctr),MAXVAL(zx_ctr)
     114  !  print *,'zx_dtr = ',sum(zx_dtr),MINVAL(zx_dtr),MAXVAL(zx_dtr)
     115  !  print *,'tr = ',sum(tr),MINVAL(tr),MAXVAL(tr)
     116  !======================================================================
     117  !== flux_tr est le flux de traceur (positif vers bas)
     118  !  DO i = 1, klon
     119  !     flux_tr(i,1) = zx_coef(i,1)/(RG*dtime)
     120  !  ENDDO
     121  !  DO k = 2, klev
     122  !  DO i = 1, klon
     123  !     flux_tr(i,k) = zx_coef(i,k)/(RG*dtime)
     124  ! .               * (local_tr(i,k)-local_tr(i,k-1))
     125  !  ENDDO
     126  !  ENDDO
     127  !======================================================================
     128  DO k = 1, klev
     129    DO i = 1, klon
     130      d_tr(i, k) = local_tr(i, k) - tr(i, k)
     131    ENDDO
     132  ENDDO
     133  ! print *,'CHECKING VALUES IN CLTRAC (END)'
     134  ! print *,'d_tr = ',sum(d_tr),MINVAL(d_tr),MAXVAL(d_tr)
     135
     136  RETURN
     137END SUBROUTINE cltrac_spl

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/cm3_to_kg.f90

    r5098 r5099  
    1       SUBROUTINE cm3_to_kg(pplay,t_seri,tr_seri)
     1SUBROUTINE cm3_to_kg(pplay, t_seri, tr_seri)
    22
    3       USE dimphy
    4       USE infotrac
    5       USE indice_sol_mod
     3  USE dimphy
     4  USE infotrac
     5  USE indice_sol_mod
    66
    7       IMPLICIT NONE
    8 c
    9       INCLUDE "dimensions.h"
    10       INCLUDE "YOMCST.h"
    11 c     
    12       REAL t_seri(klon,klev), pplay(klon,klev)
    13       REAL tr_seri(klon,klev)
    14       REAL zrho
    15       INTEGER i, k
    16 c
    17 !JE20150707      RD = 1000.0 * 1.380658E-23 * 6.0221367E+23 / 28.9644
    18       DO k = 1, klev
    19       DO i = 1, klon
    20         zrho=pplay(i,k)/t_seri(i,k)/RD
    21         tr_seri(i,k)=tr_seri(i,k)*1.e6/zrho
    22       ENDDO
    23       ENDDO
    24 c
    25       END
     7  IMPLICIT NONE
     8
     9  INCLUDE "dimensions.h"
     10  INCLUDE "YOMCST.h"
     11
     12  REAL :: t_seri(klon, klev), pplay(klon, klev)
     13  REAL :: tr_seri(klon, klev)
     14  REAL :: zrho
     15  INTEGER :: i, k
     16
     17  !JE20150707      RD = 1000.0 * 1.380658E-23 * 6.0221367E+23 / 28.9644
     18  DO k = 1, klev
     19    DO i = 1, klon
     20      zrho = pplay(i, k) / t_seri(i, k) / RD
     21      tr_seri(i, k) = tr_seri(i, k) * 1.e6 / zrho
     22    ENDDO
     23  ENDDO
     24
     25END SUBROUTINE cm3_to_kg

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/coarsemission.F

    r5082 r5099  
    2424!      CALL dustemission( debutphy, xlat, xlon, pctsrf,
    2525!     .               zu10m     zv10m,wstar,ale_bl,ale_wake)
    26 !
    2726
    2827      USE dimphy
    … …  
    276275     .     MINVAL(source_tr(:,id_coss)), MAXVAL(source_tr(:,id_coss))
    277276      ENDIF
    278 !
     277
    279278      DO i=1,klon
    280279! Original line (4 tracers)
    … …  
    287286     . flux_tr(i,id_fine)+scale_param_ssacc
    288287     .                            *lmt_sea_salt(i,1)*1.e4*1.e3      !mg/m2/s
    289 !
     288
    290289      IF(id_coss>0)  source_tr(i,id_coss)=
    291290     . scale_param_sscoa*lmt_sea_salt(i,2)*1.e4    !g/m2/s

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc.f90

    r5098 r5099  
    1       SUBROUTINE condsurfc(jour,lmt_bcff,lmt_bcbb,
    2      .                     lmt_bcbbl,lmt_bcbbh,lmt_bc_penner,
    3      .                     lmt_omff,lmt_ombb,lmt_ombbl,lmt_ombbh,
    4      .                     lmt_omnat)
    5       USE dimphy
    6       USE netcdf, ONLY: nf90_close,nf90_noerr,nf90_inq_varid,nf90_open,nf90_nowrite,nf90_get_var
    7       IMPLICIT none
    8 !
    9 ! Lire les conditions aux limites du modele pour la chimie.
    10 ! --------------------------------------------------------
    11 !
    12       INCLUDE "dimensions.h"
     1SUBROUTINE condsurfc(jour, lmt_bcff, lmt_bcbb, &
     2        lmt_bcbbl, lmt_bcbbh, lmt_bc_penner, &
     3        lmt_omff, lmt_ombb, lmt_ombbl, lmt_ombbh, &
     4        lmt_omnat)
     5  USE dimphy
     6  USE netcdf, ONLY : nf90_close, nf90_noerr, nf90_inq_varid, nf90_open, nf90_nowrite, nf90_get_var
     7  IMPLICIT none
    138
    14       REAL lmt_bcff(klon), lmt_bcbb(klon),lmt_bc_penner(klon)
    15       REAL lmt_omff(klon), lmt_ombb(klon)
    16       REAL lmt_bcbbl(klon), lmt_bcbbh(klon)
    17       REAL lmt_ombbl(klon), lmt_ombbh(klon)
    18       REAL lmt_omnat(klon)
    19       REAL lmt_terp(klon)
    20 !
    21       INTEGER jour, i
    22       INTEGER ierr
    23       INTEGER nid1,nvarid
    24       INTEGER debut(2),epais(2)
    25 !
    26       IF (jour<0 .OR. jour>(360-1)) THEN
    27          IF (jour>(360-1).AND.jour<=367) THEN
    28            jour=360-1
    29            print *,'JE: jour changed to jour= ',jour
    30          ELSE
    31            PRINT*,'Le jour demande n est pas correcte:', jour
    32            CALL ABORT
    33          ENDIF
    34       ENDIF
    35 !
    36       ierr = nf90_open ("limitcarbon.nc", nf90_nowrite, nid1)
    37       if (ierr/=nf90_noerr) then
    38         write(6,*)' Pb d''ouverture du fichier limitbc.nc'
    39         write(6,*)' ierr = ', ierr
    40         call exit(1)
    41       endif
    42 !
    43 ! Tranche a lire:
    44       debut(1) = 1
    45       debut(2) = jour+1
    46       epais(1) = klon
    47       epais(2) = 1
    48 !
    49 !
    50       ierr = nf90_inq_varid (nid1, "BCFF", nvarid)
    51       ierr = nf90_get_var(nid1, nvarid, lmt_bcff, debut, epais)
    52 !      print *,'IERR = ',ierr
    53 !      print *,'nf90_noerr = ',nf90_noerr
    54 !      print *,'debut = ',debut
    55 !      print *,'epais = ',epais
    56       IF (ierr /= nf90_noerr) THEN
    57          PRINT*, 'Pb de lecture pour les sources BC'
    58          CALL exit(1)
    59       ENDIF
    60 !
    61 !
    62       ierr = nf90_inq_varid (nid1, "BCBB", nvarid)
    63       ierr = nf90_get_var(nid1, nvarid, lmt_bcbb, debut, epais)
    64       IF (ierr /= nf90_noerr) THEN
    65          PRINT*, 'Pb de lecture pour les sources BC-biomass'
    66          CALL exit(1)
    67       ENDIF
    68 !
    69 !
    70       ierr = nf90_inq_varid (nid1, "BCBL", nvarid)
    71       ierr = nf90_get_var(nid1, nvarid, lmt_bcbbl, debut, epais)
    72       IF (ierr /= nf90_noerr) THEN
    73          PRINT*, 'Pb de lecture pour les sources BC low'
    74          CALL exit(1)
    75       ENDIF
    76 !
    77 !
    78       ierr = nf90_inq_varid (nid1, "BCBH", nvarid)
    79       ierr = nf90_get_var (nid1, nvarid, lmt_bcbbh, debut, epais)
    80       IF (ierr /= nf90_noerr) THEN
    81          PRINT*, 'Pb de lecture pour les sources BC high'
    82          CALL exit(1)
    83       ENDIF
    84 !
    85       ierr = nf90_inq_varid (nid1, "TERP", nvarid)
    86       ierr = nf90_get_var (nid1, nvarid, lmt_terp, debut, epais)
    87       IF (ierr /= nf90_noerr) THEN
    88          PRINT*, 'Pb de lecture pour les sources Terpene'
    89          CALL exit(1)
    90       ENDIF
    91 !
    92 !
    93       ierr = nf90_inq_varid (nid1, "BC_penner", nvarid)
    94       ierr = nf90_get_var (nid1, nvarid, lmt_bc_penner, debut,  epais)
    95       IF (ierr /= nf90_noerr) THEN
    96          PRINT*, 'Pb de lecture pour les sources BC Penner'
    97          CALL exit(1)
    98       ENDIF
    99 !
    100 !
    101       ierr = nf90_inq_varid (nid1, "OMFF", nvarid)
    102       ierr = nf90_get_var (nid1, nvarid, lmt_omff, debut, epais)
    103       IF (ierr /= nf90_noerr) THEN
    104          PRINT*, 'Pb de lecture pour les sources om-ifossil'
    105          CALL exit(1)
    106       ENDIF
    107 !
    108       DO i=1,klon
    109         lmt_ombb(i)  = lmt_bcbb(i)*7.0*1.6      !OC/BC=7.0;OM/OC=1.6
    110         lmt_ombbl(i) = lmt_bcbbl(i)*7.0*1.6
    111         lmt_ombbh(i) = lmt_bcbbh(i)*7.0*1.6
    112         lmt_omff(i)  = lmt_omff(i)*1.4          !--OM/OC=1.4
    113         lmt_omnat(i)  = lmt_terp(i)*0.11*1.4 !-- 11% Terpene is OC
    114       ENDDO
    115 !
    116       ierr = nf90_close(nid1)
    117       PRINT*, 'Carbon sources lues pour jour: ', jour
    118 !
    119       RETURN
    120       END
     9  ! Lire les conditions aux limites du modele pour la chimie.
     10  ! --------------------------------------------------------
     11
     12  INCLUDE "dimensions.h"
     13
     14  REAL :: lmt_bcff(klon), lmt_bcbb(klon), lmt_bc_penner(klon)
     15  REAL :: lmt_omff(klon), lmt_ombb(klon)
     16  REAL :: lmt_bcbbl(klon), lmt_bcbbh(klon)
     17  REAL :: lmt_ombbl(klon), lmt_ombbh(klon)
     18  REAL :: lmt_omnat(klon)
     19  REAL :: lmt_terp(klon)
     20
     21  INTEGER :: jour, i
     22  INTEGER :: ierr
     23  INTEGER :: nid1, nvarid
     24  INTEGER :: debut(2), epais(2)
     25
     26  IF (jour<0 .OR. jour>(360 - 1)) THEN
     27    IF (jour>(360 - 1).AND.jour<=367) THEN
     28      jour = 360 - 1
     29      print *, 'JE: jour changed to jour= ', jour
     30    ELSE
     31      PRINT*, 'Le jour demande n est pas correcte:', jour
     32      CALL ABORT
     33    ENDIF
     34  ENDIF
     35
     36  ierr = nf90_open ("limitcarbon.nc", nf90_nowrite, nid1)
     37  if (ierr/=nf90_noerr) then
     38    write(6, *)' Pb d''ouverture du fichier limitbc.nc'
     39    write(6, *)' ierr = ', ierr
     40    call exit(1)
     41  endif
     42
     43  ! Tranche a lire:
     44  debut(1) = 1
     45  debut(2) = jour + 1
     46  epais(1) = klon
     47  epais(2) = 1
     48
     49
     50  ierr = nf90_inq_varid (nid1, "BCFF", nvarid)
     51  ierr = nf90_get_var(nid1, nvarid, lmt_bcff, debut, epais)
     52  ! print *,'IERR = ',ierr
     53  ! print *,'nf90_noerr = ',nf90_noerr
     54  ! print *,'debut = ',debut
     55  ! print *,'epais = ',epais
     56  IF (ierr /= nf90_noerr) THEN
     57    PRINT*, 'Pb de lecture pour les sources BC'
     58    CALL exit(1)
     59  ENDIF
     60
     61
     62  ierr = nf90_inq_varid (nid1, "BCBB", nvarid)
     63  ierr = nf90_get_var(nid1, nvarid, lmt_bcbb, debut, epais)
     64  IF (ierr /= nf90_noerr) THEN
     65    PRINT*, 'Pb de lecture pour les sources BC-biomass'
     66    CALL exit(1)
     67  ENDIF
     68
     69
     70  ierr = nf90_inq_varid (nid1, "BCBL", nvarid)
     71  ierr = nf90_get_var(nid1, nvarid, lmt_bcbbl, debut, epais)
     72  IF (ierr /= nf90_noerr) THEN
     73    PRINT*, 'Pb de lecture pour les sources BC low'
     74    CALL exit(1)
     75  ENDIF
     76
     77
     78  ierr = nf90_inq_varid (nid1, "BCBH", nvarid)
     79  ierr = nf90_get_var (nid1, nvarid, lmt_bcbbh, debut, epais)
     80  IF (ierr /= nf90_noerr) THEN
     81    PRINT*, 'Pb de lecture pour les sources BC high'
     82    CALL exit(1)
     83  ENDIF
     84
     85  ierr = nf90_inq_varid (nid1, "TERP", nvarid)
     86  ierr = nf90_get_var (nid1, nvarid, lmt_terp, debut, epais)
     87  IF (ierr /= nf90_noerr) THEN
     88    PRINT*, 'Pb de lecture pour les sources Terpene'
     89    CALL exit(1)
     90  ENDIF
     91
     92
     93  ierr = nf90_inq_varid (nid1, "BC_penner", nvarid)
     94  ierr = nf90_get_var (nid1, nvarid, lmt_bc_penner, debut, epais)
     95  IF (ierr /= nf90_noerr) THEN
     96    PRINT*, 'Pb de lecture pour les sources BC Penner'
     97    CALL exit(1)
     98  ENDIF
     99
     100
     101  ierr = nf90_inq_varid (nid1, "OMFF", nvarid)
     102  ierr = nf90_get_var (nid1, nvarid, lmt_omff, debut, epais)
     103  IF (ierr /= nf90_noerr) THEN
     104    PRINT*, 'Pb de lecture pour les sources om-ifossil'
     105    CALL exit(1)
     106  ENDIF
     107
     108  DO i = 1, klon
     109    lmt_ombb(i) = lmt_bcbb(i) * 7.0 * 1.6      !OC/BC=7.0;OM/OC=1.6
     110    lmt_ombbl(i) = lmt_bcbbl(i) * 7.0 * 1.6
     111    lmt_ombbh(i) = lmt_bcbbh(i) * 7.0 * 1.6
     112    lmt_omff(i) = lmt_omff(i) * 1.4          !--OM/OC=1.4
     113    lmt_omnat(i) = lmt_terp(i) * 0.11 * 1.4 !-- 11% Terpene is OC
     114  ENDDO
     115
     116  ierr = nf90_close(nid1)
     117  PRINT*, 'Carbon sources lues pour jour: ', jour
     118
     119  RETURN
     120END SUBROUTINE condsurfc

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfc_new.f90

    r5098 r5099  
    1       SUBROUTINE condsurfc_new(jour,lmt_bcff, lmt_bcnff,
    2      .                         lmt_bcbbl,lmt_bcbbh, lmt_bcba,
    3      .                         lmt_omff,lmt_omnff,lmt_ombbl,lmt_ombbh,
    4      .                                             lmt_omnat, lmt_omba)
    5       USE mod_grid_phy_lmdz
    6       USE mod_phys_lmdz_para
    7       USE dimphy
    8       USE netcdf, ONLY:nf90_get_var,nf90_close,nf90_noerr,nf90_inq_varid,nf90_open,nf90_nowrite
    9       IMPLICIT none
    10 c
    11 c Lire les conditions aux limites du modele pour la chimie.
    12 c --------------------------------------------------------
    13 c
    14       INCLUDE "dimensions.h"
    15 
    16       REAL lmt_bcff(klon), lmt_bcnff(klon), lmt_bcba(klon)
    17       REAL lmt_omff(klon), lmt_omnff(klon), lmt_ombb(klon)
    18       REAL lmt_bcbbl(klon), lmt_bcbbh(klon)
    19       REAL lmt_ombbl(klon), lmt_ombbh(klon)
    20       REAL lmt_omnat(klon), lmt_omba(klon)
    21       REAL lmt_terp(klon)
    22 c
    23       REAL lmt_bcff_glo(klon_glo), lmt_bcnff_glo(klon_glo)
    24       REAL lmt_bcba_glo(klon_glo)
    25       REAL lmt_omff_glo(klon_glo), lmt_omnff_glo(klon_glo)
    26       REAL lmt_ombb_glo(klon_glo)
    27       REAL lmt_bcbbl_glo(klon_glo), lmt_bcbbh_glo(klon_glo)
    28       REAL lmt_ombbl_glo(klon_glo), lmt_ombbh_glo(klon_glo)
    29       REAL lmt_omnat_glo(klon_glo), lmt_omba_glo(klon_glo)
    30       REAL lmt_terp_glo(klon_glo)
    31 !
    32       INTEGER jour, i
    33       INTEGER ierr
    34       INTEGER nid1,nvarid
    35       INTEGER debut(2),epais(2)
    36 c
    37 !      IF (jour.LT.0 .OR. jour.GT.(366-1)) THEN
    38       IF (jour<0 .OR. jour>366) THEN
    39          PRINT*,'Le jour demande n est pas correcte:', jour
    40          print *,'JE: FORCED TO CONTINUE (emissions have
    41      . to be longer than 1 year!!!! )'
    42 !JE         CALL ABORT
    43       ENDIF
    44 
    45 !$OMP MASTER
    46       IF (is_mpi_root .AND. is_omp_root) THEN
    47 !
    48 ! Tranche a lire:
    49       debut(1) = 1
    50       debut(2) = jour
    51       epais(1) = klon_glo
    52 !      epais(1) = klon
    53       epais(2) = 1
    54 !
    55 !=======================================================================
    56 !                        BC EMISSIONS
    57 !=======================================================================
    58 !
    59       ierr = nf90_open ("carbon_emissions.nc", nf90_nowrite, nid1)
    60       if (ierr/=nf90_noerr) then
    61         write(6,*)' Pb d''ouverture du fichier limitbc.nc'
    62         write(6,*)' ierr = ', ierr
    63         call exit(1)
    64       endif
    65 !
    66 ! BC emissions from fossil fuel combustion
    67 !
    68       ierr = nf90_inq_varid (nid1, "BCFF", nvarid)
    69       ierr = nf90_get_var (nid1, nvarid, lmt_bcff_glo, debut, epais)
    70       IF (ierr /= nf90_noerr) THEN
    71          PRINT*, 'Pb de lecture pour les sources BC'
    72          CALL exit(1)
    73       ENDIF
    74       !print *,'lmt_bcff = ',lmt_bcff
    75       !stop
    76 !
    77 ! BC emissions from non fossil fuel combustion
    78 !
    79       ierr = nf90_inq_varid (nid1, "BCNFF", nvarid)
    80       ierr = nf90_get_var (nid1, nvarid, lmt_bcnff_glo, debut, epais)
    81       IF (ierr /= nf90_noerr) THEN
    82          PRINT*, 'Pb de lecture pour les sources BC'
    83          CALL exit(1)
    84       ENDIF
    85 !
    86 ! Low BC emissions from biomass burning
    87 !
    88       ierr = nf90_inq_varid (nid1, "BCBBL", nvarid)
    89       ierr = nf90_get_var (nid1, nvarid, lmt_bcbbl_glo, debut, epais)
    90       IF (ierr /= nf90_noerr) THEN
    91          PRINT*, 'Pb de lecture pour les sources BC low'
    92          CALL exit(1)
    93       ENDIF
    94 !
    95 ! High BC emissions from biomass burning
    96 !
    97       ierr = nf90_inq_varid (nid1, "BCBBH", nvarid)
    98       ierr = nf90_get_var (nid1, nvarid, lmt_bcbbh_glo, debut, epais)
    99       IF (ierr /= nf90_noerr) THEN
    100          PRINT*, 'Pb de lecture pour les sources BC high'
    101          CALL exit(1)
    102       ENDIF
    103 !
    104 ! BC emissions from ship transport
    105 !
    106       ierr = nf90_inq_varid (nid1, "BCBA", nvarid)
    107       ierr = nf90_get_var (nid1, nvarid, lmt_bcba_glo, debut, epais)
    108       IF (ierr /= nf90_noerr) THEN
    109          PRINT*, 'Pb de lecture pour les sources BC'
    110          CALL exit(1)
    111       ENDIF
    112 !
    113 !=======================================================================
    114 !                        OM EMISSIONS
    115 !=======================================================================
    116 !
    117 
    118 !
    119 ! OM emissions from fossil fuel combustion
    120 !
    121       ierr = nf90_inq_varid (nid1, "OMFF", nvarid)
    122       ierr = nf90_get_var (nid1, nvarid, lmt_omff_glo, debut, epais)
    123       IF (ierr /= nf90_noerr) THEN
    124          PRINT*, 'Pb de lecture pour les sources OM'
    125          CALL exit(1)
    126       ENDIF
    127 !
    128 ! OM emissions from non fossil fuel combustion
    129 !
    130       ierr = nf90_inq_varid (nid1, "OMNFF", nvarid)
    131       ierr = nf90_get_var (nid1, nvarid, lmt_omnff_glo, debut, epais)
    132       IF (ierr /= nf90_noerr) THEN
    133          PRINT*, 'Pb de lecture pour les sources OM'
    134          CALL exit(1)
    135       ENDIF
    136 !
    137 ! Low OM emissions from biomass burning - low
    138 !
    139       ierr = nf90_inq_varid (nid1, "OMBBL", nvarid)
    140       ierr = nf90_get_var (nid1, nvarid, lmt_ombbl_glo, debut, epais)
    141       IF (ierr /= nf90_noerr) THEN
    142          PRINT*, 'Pb de lecture pour les sources OM low'
    143          CALL exit(1)
    144       ENDIF
    145 !
    146 ! High OM emissions from biomass burning - high
    147 !
    148       ierr = nf90_inq_varid (nid1, "OMBBH", nvarid)
    149       ierr = nf90_get_var (nid1, nvarid, lmt_ombbh_glo, debut, epais)
    150       IF (ierr /= nf90_noerr) THEN
    151          PRINT*, 'Pb de lecture pour les sources OM high'
    152          CALL exit(1)
    153       ENDIF
    154 !
    155 ! High OM emissions from ship
    156 !
    157       ierr = nf90_inq_varid (nid1, "OMBA", nvarid)
    158       ierr = nf90_get_var (nid1, nvarid, lmt_omba_glo, debut, epais)
    159       IF (ierr /= nf90_noerr) THEN
    160          PRINT*, 'Pb de lecture pour les sources OM ship'
    161          CALL exit(1)
    162       ENDIF
    163 !
    164 ! Natural Terpene emissions => Natural OM emissions
    165 !
    166       ierr = nf90_inq_varid (nid1, "TERP", nvarid)
    167       ierr = nf90_get_var (nid1, nvarid, lmt_terp_glo, debut, epais)
    168       IF (ierr /= nf90_noerr) THEN
    169          PRINT*, 'Pb de lecture pour les sources Terpene'
    170          CALL exit(1)
    171       ENDIF
    172 !
    173       DO i=1,klon_glo
    174         lmt_omnat_glo(i)  = lmt_terp_glo(i)*0.11*1.4 !-- 11% Terpene is OC
    175       ENDDO
    176 
    177       ierr = nf90_close(nid1)
    178 !
    179       PRINT*, 'Carbon sources lues pour jour: ', jour
    180 !      lmt_bcff(klon)=0.0
    181 !      lmt_bcnff(klon)=0.0
    182 !      lmt_omff(klon)=0.0
    183 !      lmt_omnff(klon)=0.0
    184 !      lmt_ombb(klon)=0.0
    185 !      lmt_bcbbl(klon)=0.0
    186 !      lmt_bcbbh(klon)=0.0
    187 !      lmt_ombbl(klon)=0.0
    188 !      lmt_ombbh(klon)=0.0
    189 !      lmt_omnat(klon)=0.0
    190 !      lmt_omba(klon)=0.0
    191 !      lmt_terp(klon)=0.0
    192 
    193 
    194       ENDIF
    195 !$OMP END MASTER
    196 !$OMP BARRIER
    197       call scatter( lmt_bcff_glo   , lmt_bcff )   
    198       call scatter( lmt_bcnff_glo  , lmt_bcnff )
    199       call scatter( lmt_bcbbl_glo  , lmt_bcbbl )
    200       call scatter( lmt_bcbbh_glo  , lmt_bcbbh )
    201       call scatter( lmt_bcba_glo   , lmt_bcba )
    202       call scatter( lmt_omff_glo   , lmt_omff )
    203       call scatter( lmt_omnff_glo  , lmt_omnff )
    204       call scatter( lmt_ombbl_glo  , lmt_ombbl )
    205       call scatter( lmt_ombbh_glo  , lmt_ombbh )
    206       call scatter( lmt_omba_glo   , lmt_omba )
    207       call scatter( lmt_terp_glo   , lmt_terp )
    208       call scatter( lmt_omnat_glo  , lmt_omnat )
    209 
    210 
    211 
    212 
    213 
    214       RETURN
    215       END
     1SUBROUTINE condsurfc_new(jour, lmt_bcff, lmt_bcnff, &
     2        lmt_bcbbl, lmt_bcbbh, lmt_bcba, &
     3        lmt_omff, lmt_omnff, lmt_ombbl, lmt_ombbh, &
     4        lmt_omnat, lmt_omba)
     5  USE mod_grid_phy_lmdz
     6  USE mod_phys_lmdz_para
     7  USE dimphy
     8  USE netcdf, ONLY : nf90_get_var, nf90_close, nf90_noerr, nf90_inq_varid, nf90_open, nf90_nowrite
     9  IMPLICIT none
     10
     11  ! Lire les conditions aux limites du modele pour la chimie.
     12  ! --------------------------------------------------------
     13
     14  INCLUDE "dimensions.h"
     15
     16  REAL :: lmt_bcff(klon), lmt_bcnff(klon), lmt_bcba(klon)
     17  REAL :: lmt_omff(klon), lmt_omnff(klon), lmt_ombb(klon)
     18  REAL :: lmt_bcbbl(klon), lmt_bcbbh(klon)
     19  REAL :: lmt_ombbl(klon), lmt_ombbh(klon)
     20  REAL :: lmt_omnat(klon), lmt_omba(klon)
     21  REAL :: lmt_terp(klon)
     22
     23  REAL :: lmt_bcff_glo(klon_glo), lmt_bcnff_glo(klon_glo)
     24  REAL :: lmt_bcba_glo(klon_glo)
     25  REAL :: lmt_omff_glo(klon_glo), lmt_omnff_glo(klon_glo)
     26  REAL :: lmt_ombb_glo(klon_glo)
     27  REAL :: lmt_bcbbl_glo(klon_glo), lmt_bcbbh_glo(klon_glo)
     28  REAL :: lmt_ombbl_glo(klon_glo), lmt_ombbh_glo(klon_glo)
     29  REAL :: lmt_omnat_glo(klon_glo), lmt_omba_glo(klon_glo)
     30  REAL :: lmt_terp_glo(klon_glo)
     31
     32  INTEGER :: jour, i
     33  INTEGER :: ierr
     34  INTEGER :: nid1, nvarid
     35  INTEGER :: debut(2), epais(2)
     36
     37  !  IF (jour.LT.0 .OR. jour.GT.(366-1)) THEN
     38  IF (jour<0 .OR. jour>366) THEN
     39    PRINT*, 'Le jour demande n est pas correcte:', jour
     40    print *, 'JE: FORCED TO CONTINUE (emissions have&
     41            & to be longer than 1 year!!!! )'
     42    !JE         CALL ABORT
     43  ENDIF
     44
     45  !$OMP MASTER
     46  IF (is_mpi_root .AND. is_omp_root) THEN
     47
     48    ! Tranche a lire:
     49    debut(1) = 1
     50    debut(2) = jour
     51    epais(1) = klon_glo
     52    ! epais(1) = klon
     53    epais(2) = 1
     54
     55    !=======================================================================
     56    !                    BC EMISSIONS
     57    !=======================================================================
     58
     59    ierr = nf90_open ("carbon_emissions.nc", nf90_nowrite, nid1)
     60    if (ierr/=nf90_noerr) then
     61      write(6, *)' Pb d''ouverture du fichier limitbc.nc'
     62      write(6, *)' ierr = ', ierr
     63      call exit(1)
     64    endif
     65
     66    ! BC emissions from fossil fuel combustion
     67
     68    ierr = nf90_inq_varid (nid1, "BCFF", nvarid)
     69    ierr = nf90_get_var (nid1, nvarid, lmt_bcff_glo, debut, epais)
     70    IF (ierr /= nf90_noerr) THEN
     71      PRINT*, 'Pb de lecture pour les sources BC'
     72      CALL exit(1)
     73    ENDIF
     74    ! !print *,'lmt_bcff = ',lmt_bcff
     75    ! !stop
     76
     77    ! BC emissions from non fossil fuel combustion
     78
     79    ierr = nf90_inq_varid (nid1, "BCNFF", nvarid)
     80    ierr = nf90_get_var (nid1, nvarid, lmt_bcnff_glo, debut, epais)
     81    IF (ierr /= nf90_noerr) THEN
     82      PRINT*, 'Pb de lecture pour les sources BC'
     83      CALL exit(1)
     84    ENDIF
     85
     86    ! Low BC emissions from biomass burning
     87
     88    ierr = nf90_inq_varid (nid1, "BCBBL", nvarid)
     89    ierr = nf90_get_var (nid1, nvarid, lmt_bcbbl_glo, debut, epais)
     90    IF (ierr /= nf90_noerr) THEN
     91      PRINT*, 'Pb de lecture pour les sources BC low'
     92      CALL exit(1)
     93    ENDIF
     94
     95    ! High BC emissions from biomass burning
     96
     97    ierr = nf90_inq_varid (nid1, "BCBBH", nvarid)
     98    ierr = nf90_get_var (nid1, nvarid, lmt_bcbbh_glo, debut, epais)
     99    IF (ierr /= nf90_noerr) THEN
     100      PRINT*, 'Pb de lecture pour les sources BC high'
     101      CALL exit(1)
     102    ENDIF
     103
     104    ! BC emissions from ship transport
     105
     106    ierr = nf90_inq_varid (nid1, "BCBA", nvarid)
     107    ierr = nf90_get_var (nid1, nvarid, lmt_bcba_glo, debut, epais)
     108    IF (ierr /= nf90_noerr) THEN
     109      PRINT*, 'Pb de lecture pour les sources BC'
     110      CALL exit(1)
     111    ENDIF
     112
     113    !=======================================================================
     114    ! OM EMISSIONS
     115    !=======================================================================
     116
     117    ! OM emissions from fossil fuel combustion
     118
     119    ierr = nf90_inq_varid (nid1, "OMFF", nvarid)
     120    ierr = nf90_get_var (nid1, nvarid, lmt_omff_glo, debut, epais)
     121    IF (ierr /= nf90_noerr) THEN
     122      PRINT*, 'Pb de lecture pour les sources OM'
     123      CALL exit(1)
     124    ENDIF
     125
     126    ! OM emissions from non fossil fuel combustion
     127
     128    ierr = nf90_inq_varid (nid1, "OMNFF", nvarid)
     129    ierr = nf90_get_var (nid1, nvarid, lmt_omnff_glo, debut, epais)
     130    IF (ierr /= nf90_noerr) THEN
     131      PRINT*, 'Pb de lecture pour les sources OM'
     132      CALL exit(1)
     133    ENDIF
     134
     135    ! Low OM emissions from biomass burning - low
     136
     137    ierr = nf90_inq_varid (nid1, "OMBBL", nvarid)
     138    ierr = nf90_get_var (nid1, nvarid, lmt_ombbl_glo, debut, epais)
     139    IF (ierr /= nf90_noerr) THEN
     140      PRINT*, 'Pb de lecture pour les sources OM low'
     141      CALL exit(1)
     142    ENDIF
     143
     144    ! High OM emissions from biomass burning - high
     145
     146    ierr = nf90_inq_varid (nid1, "OMBBH", nvarid)
     147    ierr = nf90_get_var (nid1, nvarid, lmt_ombbh_glo, debut, epais)
     148    IF (ierr /= nf90_noerr) THEN
     149      PRINT*, 'Pb de lecture pour les sources OM high'
     150      CALL exit(1)
     151    ENDIF
     152
     153    ! High OM emissions from ship
     154
     155    ierr = nf90_inq_varid (nid1, "OMBA", nvarid)
     156    ierr = nf90_get_var (nid1, nvarid, lmt_omba_glo, debut, epais)
     157    IF (ierr /= nf90_noerr) THEN
     158      PRINT*, 'Pb de lecture pour les sources OM ship'
     159      CALL exit(1)
     160    ENDIF
     161
     162    ! Natural Terpene emissions => Natural OM emissions
     163
     164    ierr = nf90_inq_varid (nid1, "TERP", nvarid)
     165    ierr = nf90_get_var (nid1, nvarid, lmt_terp_glo, debut, epais)
     166    IF (ierr /= nf90_noerr) THEN
     167      PRINT*, 'Pb de lecture pour les sources Terpene'
     168      CALL exit(1)
     169    ENDIF
     170
     171    DO i = 1, klon_glo
     172      lmt_omnat_glo(i) = lmt_terp_glo(i) * 0.11 * 1.4 !-- 11% Terpene is OC
     173    ENDDO
     174
     175    ierr = nf90_close(nid1)
     176
     177    PRINT*, 'Carbon sources lues pour jour: ', jour
     178    ! lmt_bcff(klon)=0.0
     179    ! lmt_bcnff(klon)=0.0
     180    ! lmt_omff(klon)=0.0
     181    ! lmt_omnff(klon)=0.0
     182    ! lmt_ombb(klon)=0.0
     183    ! lmt_bcbbl(klon)=0.0
     184    ! lmt_bcbbh(klon)=0.0
     185    ! lmt_ombbl(klon)=0.0
     186    ! lmt_ombbh(klon)=0.0
     187    ! lmt_omnat(klon)=0.0
     188    ! lmt_omba(klon)=0.0
     189    ! lmt_terp(klon)=0.0
     190
     191  ENDIF
     192  !$OMP END MASTER
     193  !$OMP BARRIER
     194  call scatter(lmt_bcff_glo, lmt_bcff)
     195  call scatter(lmt_bcnff_glo, lmt_bcnff)
     196  call scatter(lmt_bcbbl_glo, lmt_bcbbl)
     197  call scatter(lmt_bcbbh_glo, lmt_bcbbh)
     198  call scatter(lmt_bcba_glo, lmt_bcba)
     199  call scatter(lmt_omff_glo, lmt_omff)
     200  call scatter(lmt_omnff_glo, lmt_omnff)
     201  call scatter(lmt_ombbl_glo, lmt_ombbl)
     202  call scatter(lmt_ombbh_glo, lmt_ombbh)
     203  call scatter(lmt_omba_glo, lmt_omba)
     204  call scatter(lmt_terp_glo, lmt_terp)
     205  call scatter(lmt_omnat_glo, lmt_omnat)
     206
     207  RETURN
     208END SUBROUTINE condsurfc_new

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs.f90

    r5098 r5099  
    1       SUBROUTINE condsurfs(jour, edgar, flag_dms,
    2      .                     lmt_so2h, lmt_so2b, lmt_so2bb, lmt_so2ba,
    3      .                     lmt_so2volc, lmt_altvolc, 
    4      .                     lmt_dmsbio, lmt_h2sbio, lmt_dms, lmt_dmsconc)
    5        USE dimphy
    6        USE netcdf, ONLY:nf90_close,nf90_noerr,nf90_inq_varid,nf90_open,nf90_nowrite,nf90_get_var
    7       IMPLICIT none
    8 c
    9 c Lire les conditions aux limites du modele pour la chimie.
    10 c --------------------------------------------------------
    11 c
    12       INCLUDE "dimensions.h"
    13 c
    14       REAL lmt_so2h(klon), lmt_so2b(klon), lmt_so2bb(klon)
    15       REAL lmt_dmsbio(klon), lmt_h2sbio(klon), lmt_so2ba(klon)
    16       REAL lmt_so2volc(klon), lmt_altvolc(klon)
    17       REAL lmt_dms(klon), lmt_dmsconc(klon)
    18       LOGICAL edgar
    19       INTEGER flag_dms
    20 c
    21       INTEGER jour, i
    22       INTEGER ierr
    23       INTEGER nid,nvarid
    24       INTEGER debut(2),epais(2)
    25 c
    26       IF (jour<0 .OR. jour>(360-1)) THEN
    27          IF ((jour>(360-1)) .AND. (jour<=367)) THEN
    28            jour=360-1
    29            print *,'JE: jour changed to jour= ',jour
    30          ELSE
    31            PRINT*,'Le jour demande n est pas correcte:', jour
    32            CALL ABORT
    33          ENDIF
    34       ENDIF
    35 c
    36       ierr = nf90_open ("limitsoufre.nc", nf90_nowrite, nid)
    37       if (ierr/=nf90_noerr) then
    38         write(6,*)' Pb d''ouverture du fichier limitsoufre.nc'
    39         write(6,*)' ierr = ', ierr
    40         call exit(1)
    41       endif
    42 c
    43 c Tranche a lire:
    44       debut(1) = 1
    45       debut(2) = jour+1
    46       epais(1) = klon
    47       epais(2) = 1
    48 c
    49       ierr = nf90_inq_varid (nid, "VOLC", nvarid)
    50       ierr = nf90_get_var(nid, nvarid, lmt_so2volc, debut, epais)
    51       IF (ierr /= nf90_noerr) THEN
    52          PRINT*, 'Pb de lecture pour les sources so2 volcan'
    53          CALL exit(1)
    54       ENDIF
    55 c
    56       ierr = nf90_inq_varid (nid, "ALTI", nvarid)
    57       ierr = nf90_get_var(nid, nvarid, lmt_altvolc, debut, epais)
    58       IF (ierr /= nf90_noerr) THEN
    59          PRINT*, 'Pb de lecture pour les altitudes volcan'
    60          CALL exit(1)
    61       ENDIF
    62 c
    63       IF (edgar) THEN   !--EDGAR w/o ship and biomass burning
    64 c
    65       ierr = nf90_inq_varid (nid, "SO2ED95L", nvarid)
    66       ierr = nf90_get_var(nid, nvarid, lmt_so2b, debut, epais)
    67       IF (ierr /= nf90_noerr) THEN
    68          PRINT*, 'Pb de lecture pour les sources so2 edgar low'
    69          CALL exit(1)
    70       ENDIF
    71 c
    72       ierr = nf90_inq_varid (nid, "SO2ED95H", nvarid)
    73       ierr = nf90_get_var(nid, nvarid, lmt_so2h, debut, epais)
    74       IF (ierr /= nf90_noerr) THEN
    75          PRINT*, 'Pb de lecture pour les sources so2 edgar high'
    76          CALL exit(1)
    77       ENDIF
    78 c
    79       ELSE  !--GEIA
    80 c
    81       ierr = nf90_inq_varid (nid, "SO2H", nvarid)
    82       ierr = nf90_get_var(nid, nvarid, lmt_so2h, debut, epais)
    83       IF (ierr /= nf90_noerr) THEN
    84          PRINT*, 'Pb de lecture pour les sources so2 haut'
    85          CALL exit(1)
    86       ENDIF
    87 c
    88       ierr = nf90_inq_varid (nid, "SO2B", nvarid)
    89       ierr = nf90_get_var(nid, nvarid, lmt_so2b, debut, epais)
    90       IF (ierr /= nf90_noerr) THEN
    91          PRINT*, 'Pb de lecture pour les sources so2 bas'
    92          CALL exit(1)
    93       ENDIF
    94 c
    95       ENDIF  !--edgar
    96 c
    97       ierr = nf90_inq_varid (nid, "SO2BB", nvarid)
    98       ierr = nf90_get_var(nid, nvarid, lmt_so2bb, debut, epais)
    99       IF (ierr /= nf90_noerr) THEN
    100          PRINT*, 'Pb de lecture pour les sources so2 bb'
    101          CALL exit(1)
    102       ENDIF
    103 c
    104       ierr = nf90_inq_varid (nid, "SO2BA", nvarid)
    105       ierr = nf90_get_var(nid, nvarid, lmt_so2ba, debut, epais)
    106       IF (ierr /= nf90_noerr) THEN
    107          PRINT*, 'Pb de lecture pour les sources so2 bateau'
    108          CALL exit(1)
    109       ENDIF
    110 c
    111       ierr = nf90_inq_varid (nid, "DMSB", nvarid)
    112       ierr = nf90_get_var(nid, nvarid, lmt_dmsbio, debut, epais)
    113       IF (ierr /= nf90_noerr) THEN
    114          PRINT*, 'Pb de lecture pour les sources dms bio'
    115          CALL exit(1)
    116       ENDIF
    117 c
    118       ierr = nf90_inq_varid (nid, "H2SB", nvarid)
    119       ierr = nf90_get_var(nid, nvarid, lmt_h2sbio, debut, epais)
    120       IF (ierr /= nf90_noerr) THEN
    121          PRINT*, 'Pb de lecture pour les sources h2s bio'
    122          CALL exit(1)
    123       ENDIF
    124 c
    125       IF (flag_dms==1) THEN
    126 c
    127       ierr = nf90_inq_varid (nid, "DMSL", nvarid)
    128       ierr = nf90_get_var(nid, nvarid, lmt_dms, debut, epais)
    129       IF (ierr /= nf90_noerr) THEN
    130          PRINT*, 'Pb de lecture pour les sources dms liss'
    131          CALL exit(1)
    132       ENDIF
    133 c
    134       ELSEIF (flag_dms==2) THEN
    135 c
    136       ierr = nf90_inq_varid (nid, "DMSW", nvarid)
    137       ierr = nf90_get_var(nid, nvarid, lmt_dms, debut, epais)
    138       IF (ierr /= nf90_noerr) THEN
    139          PRINT*, 'Pb de lecture pour les sources dms wann'
    140          CALL exit(1)
    141       ENDIF
    142 c
    143       ELSEIF (flag_dms==3) THEN
    144 c
    145       ierr = nf90_inq_varid (nid, "DMSC1", nvarid)
    146       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    147       IF (ierr /= nf90_noerr) THEN
    148          PRINT*, 'Pb de lecture pour les sources dmsconc old'
    149          CALL exit(1)
    150       ENDIF
    151 c
    152       ELSEIF (flag_dms==4) THEN
    153 c
    154       ierr = nf90_inq_varid (nid, "DMSC2", nvarid)
    155       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    156       IF (ierr /= nf90_noerr) THEN
    157          PRINT*, 'Pb de lecture pour les sources dms conc 2'
    158          CALL exit(1)
    159       ENDIF
    160 c
    161       ELSEIF (flag_dms==5) THEN
    162 c
    163       ierr = nf90_inq_varid (nid, "DMSC3", nvarid)
    164       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    165       IF (ierr /= nf90_noerr) THEN
    166          PRINT*, 'Pb de lecture pour les sources dms conc 3'
    167          CALL exit(1)
    168       ENDIF
    169 c
    170       ELSEIF (flag_dms==6) THEN
    171 c
    172       ierr = nf90_inq_varid (nid, "DMSC4", nvarid)
    173       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    174       IF (ierr /= nf90_noerr) THEN
    175          PRINT*, 'Pb de lecture pour les sources dms conc 4'
    176          CALL exit(1)
    177       ENDIF
    178 c
    179       ELSEIF (flag_dms==7) THEN
    180 c
    181       ierr = nf90_inq_varid (nid, "DMSC5", nvarid)
    182       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    183       IF (ierr /= nf90_noerr) THEN
    184          PRINT*, 'Pb de lecture pour les sources dms conc 5'
    185          CALL exit(1)
    186       ENDIF
    187 c
    188       ELSEIF (flag_dms==8) THEN
    189 c
    190       ierr = nf90_inq_varid (nid, "DMSC6", nvarid)
    191       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    192       IF (ierr /= nf90_noerr) THEN
    193          PRINT*, 'Pb de lecture pour les sources dms conc 6'
    194          CALL exit(1)
    195       ENDIF
    196 c
    197       ELSEIF (flag_dms==9) THEN
    198 c
    199       ierr = nf90_inq_varid (nid, "DMSC7", nvarid)
    200       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    201       IF (ierr /= nf90_noerr) THEN
    202          PRINT*, 'Pb de lecture pour les sources dms conc 7'
    203          CALL exit(1)
    204       ENDIF
    205 c
    206       ELSEIF (flag_dms==10) THEN
    207 c
    208       ierr = nf90_inq_varid (nid, "DMSC8", nvarid)
    209       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    210       IF (ierr /= nf90_noerr) THEN
    211          PRINT*, 'Pb de lecture pour les sources dms conc 8'
    212          CALL exit(1)
    213       ENDIF
    214 c
    215       ELSE
    216 c
    217          PRINT *,'choix non possible pour flag_dms'
    218          STOP
    219 c
    220       ENDIF
    221 c
    222       ierr = nf90_close(nid)
    223 c
    224       IF (flag_dms<=2) THEN
    225       DO i=1, klon
    226          lmt_dmsconc(i)=0.0
    227       ENDDO
    228       ELSE
    229       DO i=1, klon
    230          lmt_dms(i)=0.0
    231       ENDDO
    232       ENDIF
    233 c
    234       PRINT*, 'Sources SOUFRE lues pour jour: ', jour
    235 c
    236       RETURN
    237       END
     1SUBROUTINE condsurfs(jour, edgar, flag_dms, &
     2        lmt_so2h, lmt_so2b, lmt_so2bb, lmt_so2ba, &
     3        lmt_so2volc, lmt_altvolc, &
     4        lmt_dmsbio, lmt_h2sbio, lmt_dms, lmt_dmsconc)
     5  USE dimphy
     6  USE netcdf, ONLY : nf90_close, nf90_noerr, nf90_inq_varid, nf90_open, &
     7          nf90_nowrite, nf90_get_var
     8  IMPLICIT none
     9
     10  ! Lire les conditions aux limites du modele pour la chimie.
     11  ! --------------------------------------------------------
     12
     13  INCLUDE "dimensions.h"
     14
     15  REAL :: lmt_so2h(klon), lmt_so2b(klon), lmt_so2bb(klon)
     16  REAL :: lmt_dmsbio(klon), lmt_h2sbio(klon), lmt_so2ba(klon)
     17  REAL :: lmt_so2volc(klon), lmt_altvolc(klon)
     18  REAL :: lmt_dms(klon), lmt_dmsconc(klon)
     19  LOGICAL :: edgar
     20  INTEGER :: flag_dms
     21
     22  INTEGER :: jour, i
     23  INTEGER :: ierr
     24  INTEGER :: nid, nvarid
     25  INTEGER :: debut(2), epais(2)
     26
     27  IF (jour<0 .OR. jour>(360 - 1)) THEN
     28    IF ((jour>(360 - 1)) .AND. (jour<=367)) THEN
     29      jour = 360 - 1
     30      print *, 'JE: jour changed to jour= ', jour
     31    ELSE
     32      PRINT*, 'Le jour demande n est pas correcte:', jour
     33      CALL ABORT
     34    ENDIF
     35  ENDIF
     36
     37  ierr = nf90_open ("limitsoufre.nc", nf90_nowrite, nid)
     38  if (ierr/=nf90_noerr) then
     39    write(6, *)' Pb d''ouverture du fichier limitsoufre.nc'
     40    write(6, *)' ierr = ', ierr
     41    call exit(1)
     42  endif
     43
     44  ! Tranche a lire:
     45  debut(1) = 1
     46  debut(2) = jour + 1
     47  epais(1) = klon
     48  epais(2) = 1
     49
     50  ierr = nf90_inq_varid (nid, "VOLC", nvarid)
     51  ierr = nf90_get_var(nid, nvarid, lmt_so2volc, debut, epais)
     52  IF (ierr /= nf90_noerr) THEN
     53    PRINT*, 'Pb de lecture pour les sources so2 volcan'
     54    CALL exit(1)
     55  ENDIF
     56
     57  ierr = nf90_inq_varid (nid, "ALTI", nvarid)
     58  ierr = nf90_get_var(nid, nvarid, lmt_altvolc, debut, epais)
     59  IF (ierr /= nf90_noerr) THEN
     60    PRINT*, 'Pb de lecture pour les altitudes volcan'
     61    CALL exit(1)
     62  ENDIF
     63
     64  IF (edgar) THEN   !--EDGAR w/o ship and biomass burning
     65
     66    ierr = nf90_inq_varid (nid, "SO2ED95L", nvarid)
     67    ierr = nf90_get_var(nid, nvarid, lmt_so2b, debut, epais)
     68    IF (ierr /= nf90_noerr) THEN
     69      PRINT*, 'Pb de lecture pour les sources so2 edgar low'
     70      CALL exit(1)
     71    ENDIF
     72
     73    ierr = nf90_inq_varid (nid, "SO2ED95H", nvarid)
     74    ierr = nf90_get_var(nid, nvarid, lmt_so2h, debut, epais)
     75    IF (ierr /= nf90_noerr) THEN
     76      PRINT*, 'Pb de lecture pour les sources so2 edgar high'
     77      CALL exit(1)
     78    ENDIF
     79
     80  ELSE  !--GEIA
     81
     82    ierr = nf90_inq_varid (nid, "SO2H", nvarid)
     83    ierr = nf90_get_var(nid, nvarid, lmt_so2h, debut, epais)
     84    IF (ierr /= nf90_noerr) THEN
     85      PRINT*, 'Pb de lecture pour les sources so2 haut'
     86      CALL exit(1)
     87    ENDIF
     88
     89    ierr = nf90_inq_varid (nid, "SO2B", nvarid)
     90    ierr = nf90_get_var(nid, nvarid, lmt_so2b, debut, epais)
     91    IF (ierr /= nf90_noerr) THEN
     92      PRINT*, 'Pb de lecture pour les sources so2 bas'
     93      CALL exit(1)
     94    ENDIF
     95
     96  ENDIF  !--edgar
     97
     98  ierr = nf90_inq_varid (nid, "SO2BB", nvarid)
     99  ierr = nf90_get_var(nid, nvarid, lmt_so2bb, debut, epais)
     100  IF (ierr /= nf90_noerr) THEN
     101    PRINT*, 'Pb de lecture pour les sources so2 bb'
     102    CALL exit(1)
     103  ENDIF
     104
     105  ierr = nf90_inq_varid (nid, "SO2BA", nvarid)
     106  ierr = nf90_get_var(nid, nvarid, lmt_so2ba, debut, epais)
     107  IF (ierr /= nf90_noerr) THEN
     108    PRINT*, 'Pb de lecture pour les sources so2 bateau'
     109    CALL exit(1)
     110  ENDIF
     111
     112  ierr = nf90_inq_varid (nid, "DMSB", nvarid)
     113  ierr = nf90_get_var(nid, nvarid, lmt_dmsbio, debut, epais)
     114  IF (ierr /= nf90_noerr) THEN
     115    PRINT*, 'Pb de lecture pour les sources dms bio'
     116    CALL exit(1)
     117  ENDIF
     118
     119  ierr = nf90_inq_varid (nid, "H2SB", nvarid)
     120  ierr = nf90_get_var(nid, nvarid, lmt_h2sbio, debut, epais)
     121  IF (ierr /= nf90_noerr) THEN
     122    PRINT*, 'Pb de lecture pour les sources h2s bio'
     123    CALL exit(1)
     124  ENDIF
     125
     126  IF (flag_dms==1) THEN
     127
     128    ierr = nf90_inq_varid (nid, "DMSL", nvarid)
     129    ierr = nf90_get_var(nid, nvarid, lmt_dms, debut, epais)
     130    IF (ierr /= nf90_noerr) THEN
     131      PRINT*, 'Pb de lecture pour les sources dms liss'
     132      CALL exit(1)
     133    ENDIF
     134
     135  ELSEIF (flag_dms==2) THEN
     136
     137    ierr = nf90_inq_varid (nid, "DMSW", nvarid)
     138    ierr = nf90_get_var(nid, nvarid, lmt_dms, debut, epais)
     139    IF (ierr /= nf90_noerr) THEN
     140      PRINT*, 'Pb de lecture pour les sources dms wann'
     141      CALL exit(1)
     142    ENDIF
     143
     144  ELSEIF (flag_dms==3) THEN
     145
     146    ierr = nf90_inq_varid (nid, "DMSC1", nvarid)
     147    ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
     148    IF (ierr /= nf90_noerr) THEN
     149      PRINT*, 'Pb de lecture pour les sources dmsconc old'
     150      CALL exit(1)
     151    ENDIF
     152
     153  ELSEIF (flag_dms==4) THEN
     154
     155    ierr = nf90_inq_varid (nid, "DMSC2", nvarid)
     156    ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
     157    IF (ierr /= nf90_noerr) THEN
     158      PRINT*, 'Pb de lecture pour les sources dms conc 2'
     159      CALL exit(1)
     160    ENDIF
     161
     162  ELSEIF (flag_dms==5) THEN
     163
     164    ierr = nf90_inq_varid (nid, "DMSC3", nvarid)
     165    ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
     166    IF (ierr /= nf90_noerr) THEN
     167      PRINT*, 'Pb de lecture pour les sources dms conc 3'
     168      CALL exit(1)
     169    ENDIF
     170
     171  ELSEIF (flag_dms==6) THEN
     172
     173    ierr = nf90_inq_varid (nid, "DMSC4", nvarid)
     174    ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
     175    IF (ierr /= nf90_noerr) THEN
     176      PRINT*, 'Pb de lecture pour les sources dms conc 4'
     177      CALL exit(1)
     178    ENDIF
     179
     180  ELSEIF (flag_dms==7) THEN
     181
     182    ierr = nf90_inq_varid (nid, "DMSC5", nvarid)
     183    ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
     184    IF (ierr /= nf90_noerr) THEN
     185      PRINT*, 'Pb de lecture pour les sources dms conc 5'
     186      CALL exit(1)
     187    ENDIF
     188
     189  ELSEIF (flag_dms==8) THEN
     190
     191    ierr = nf90_inq_varid (nid, "DMSC6", nvarid)
     192    ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
     193    IF (ierr /= nf90_noerr) THEN
     194      PRINT*, 'Pb de lecture pour les sources dms conc 6'
     195      CALL exit(1)
     196    ENDIF
     197
     198  ELSEIF (flag_dms==9) THEN
     199
     200    ierr = nf90_inq_varid (nid, "DMSC7", nvarid)
     201    ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
     202    IF (ierr /= nf90_noerr) THEN
     203      PRINT*, 'Pb de lecture pour les sources dms conc 7'
     204      CALL exit(1)
     205    ENDIF
     206
     207  ELSEIF (flag_dms==10) THEN
     208
     209    ierr = nf90_inq_varid (nid, "DMSC8", nvarid)
     210    ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
     211    IF (ierr /= nf90_noerr) THEN
     212      PRINT*, 'Pb de lecture pour les sources dms conc 8'
     213      CALL exit(1)
     214    ENDIF
     215
     216  ELSE
     217
     218    PRINT *, 'choix non possible pour flag_dms'
     219    STOP
     220
     221  ENDIF
     222
     223  ierr = nf90_close(nid)
     224
     225  IF (flag_dms<=2) THEN
     226    DO i = 1, klon
     227      lmt_dmsconc(i) = 0.0
     228    ENDDO
     229  ELSE
     230    DO i = 1, klon
     231      lmt_dms(i) = 0.0
     232    ENDDO
     233  ENDIF
     234
     235  PRINT*, 'Sources SOUFRE lues pour jour: ', jour
     236
     237  RETURN
     238END SUBROUTINE condsurfs

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/condsurfs_new.f90

    r5098 r5099  
    1       SUBROUTINE condsurfs_new(jour, edgar, flag_dms,
    2      .                         lmt_so2b, lmt_so2h, lmt_so2nff,
    3      .                         lmt_so2bb_l, lmt_so2bb_h, lmt_so2ba,
    4      .                         lmt_so2volc_cont, lmt_altvolc_cont, 
    5      .                         lmt_so2volc_expl, lmt_altvolc_expl, 
    6      .                         lmt_dmsbio, lmt_h2sbio, lmt_dms,
    7      .                                                      lmt_dmsconc)
    8       USE mod_grid_phy_lmdz
    9       USE mod_phys_lmdz_para
    10       USE dimphy
    11       USE netcdf, ONLY: nf90_get_var,nf90_inq_varid,nf90_close,nf90_noerr,nf90_open,nf90_nowrite
    12       IMPLICIT none
    13 c
    14 c Lire les conditions aux limites du modele pour la chimie.
    15 c --------------------------------------------------------
    16 c
    17       INCLUDE "dimensions.h"
    18 c
    19       REAL lmt_so2b(klon), lmt_so2h(klon), lmt_so2nff(klon)
    20       REAL lmt_so2bb_l(klon), lmt_so2bb_h(klon)
    21       REAL lmt_dmsbio(klon), lmt_h2sbio(klon), lmt_so2ba(klon)
    22       REAL lmt_so2volc_cont(klon), lmt_altvolc_cont(klon)
    23       REAL lmt_so2volc_expl(klon), lmt_altvolc_expl(klon)
    24       REAL lmt_dms(klon), lmt_dmsconc(klon)
    25 
    26       REAL lmt_so2b_glo(klon_glo), lmt_so2h_glo(klon_glo)
    27       REAL lmt_so2nff_glo(klon_glo)
    28       REAL lmt_so2bb_l_glo(klon_glo), lmt_so2bb_h_glo(klon_glo)
    29       REAL lmt_dmsbio_glo(klon_glo), lmt_h2sbio_glo(klon_glo)
    30       REAL lmt_so2ba_glo(klon_glo)
    31       REAL lmt_so2volc_cont_glo(klon_glo),lmt_altvolc_cont_glo(klon_glo)
    32       REAL lmt_so2volc_expl_glo(klon_glo),lmt_altvolc_expl_glo(klon_glo)
    33       REAL lmt_dms_glo(klon_glo), lmt_dmsconc_glo(klon_glo)
    34       LOGICAL edgar
    35       INTEGER flag_dms
    36 c
    37       INTEGER jour, i
    38       INTEGER ierr
    39       INTEGER nid,nvarid
    40       INTEGER debut(2),epais(2)
    41 c
    42       IF (jour<0 .OR. jour>(366-1)) THEN
    43          PRINT*,'Le jour demande n est pas correcte:', jour
    44          print *,'JE: FORCED TO CONTINUE (emissions have
    45      . to be longer than 1 year!!!! )'
    46 !         CALL ABORT
    47       ENDIF
    48 !
    49 
    50 !$OMP MASTER
    51       IF (is_mpi_root .AND. is_omp_root) THEN
    52 
    53 c Tranche a lire:
    54       debut(1) = 1
    55       debut(2) = jour
    56 !      epais(1) = klon
    57       epais(1) = klon_glo
    58       epais(2) = 1
    59 !=======================================================================
    60 !                 READING NEW EMISSIONS FROM RCP
    61 !=======================================================================
    62 !
    63       ierr = nf90_open ("sulphur_emissions_antro.nc", nf90_nowrite, nid)
    64       if (ierr/=nf90_noerr) then
    65         write(6,*)' Pb d''ouverture du fichier sulphur_emissions_antro'
    66         write(6,*)' ierr = ', ierr
    67         call exit(1)
    68       endif
    69 
    70 !
    71 ! SO2 Low level emissions
    72 !
    73       ierr = nf90_inq_varid (nid, "SO2FF_LOW", nvarid)
    74       ierr = nf90_get_var(nid, nvarid, lmt_so2b_glo, debut, epais)
    75       IF (ierr /= nf90_noerr) THEN
    76         PRINT*, 'Pb de lecture pour les sources so2 low'
    77         print *,'JE klon, jour, debut ,epais ',klon_glo,jour,debut,epais
    78         CALL HANDLE_ERR(ierr)
    79         print *,'error ierr= ',ierr
    80         CALL exit(1)
    81       ENDIF
    82 !
    83 ! SO2 High level emissions
    84 !
    85       ierr = nf90_inq_varid (nid, "SO2FF_HIGH", nvarid)
    86       ierr = nf90_get_var(nid, nvarid, lmt_so2h_glo, debut, epais)
    87       IF (ierr /= nf90_noerr) THEN
    88         PRINT*, 'Pb de lecture pour les sources so2 high'
    89         CALL exit(1)
    90       ENDIF
    91 !
    92 ! SO2 Biomass burning High level emissions
    93 !
    94       ierr = nf90_inq_varid (nid, "SO2BBH", nvarid)
    95       ierr = nf90_get_var(nid, nvarid,  lmt_so2bb_h_glo, debut, epais)
    96       IF (ierr /= nf90_noerr) THEN
    97         PRINT*, 'Pb de lecture pour les sources so2 BB high'
    98         CALL exit(1)
    99       ENDIF
    100 !
    101 ! SO2 biomass burning low level emissions
    102 !
    103       ierr = nf90_inq_varid (nid, "SO2BBL", nvarid)
    104       ierr = nf90_get_var(nid, nvarid,  lmt_so2bb_l_glo, debut, epais)
    105       IF (ierr /= nf90_noerr) THEN
    106         PRINT*, 'Pb de lecture pour les sources so2 BB low'
    107         CALL exit(1)
    108       ENDIF
    109 !
    110 ! SO2 ship emissions
    111 !
    112       ierr = nf90_inq_varid (nid, "SO2BA", nvarid)
    113       ierr = nf90_get_var(nid, nvarid, lmt_so2ba_glo, debut, epais)
    114       IF (ierr /= nf90_noerr) THEN
    115         PRINT*, 'Pb de lecture pour les sources so2 ship'
    116         CALL exit(1)
    117       ENDIF
    118 !
    119 ! SO2 Non Fossil Fuel Emissions
    120 !
    121       ierr = nf90_inq_varid (nid, "SO2NFF", nvarid)
    122       ierr = nf90_get_var(nid, nvarid, lmt_so2nff_glo, debut, epais)
    123       IF (ierr /= nf90_noerr) THEN
    124         PRINT*, 'Pb de lecture pour les sources so2 non FF'
    125         CALL exit(1)
    126       ENDIF
    127 !
    128       ierr = nf90_close(nid)
    129 !
    130 !=======================================================================
    131 !                      READING NATURAL EMISSIONS
    132 !=======================================================================
    133       ierr = nf90_open ("sulphur_emissions_nat.nc", nf90_nowrite, nid)
    134       if (ierr/=nf90_noerr) then
    135         write(6,*)' Pb d''ouverture du fichier sulphur_emissions_nat'
    136         write(6,*)' ierr = ', ierr
    137         call exit(1)
    138       endif
    139 c
    140 c Biologenic source of DMS
    141 c
    142       ierr = nf90_inq_varid (nid, "DMSB", nvarid)
    143       ierr = nf90_get_var(nid, nvarid, lmt_dmsbio_glo, debut, epais)
    144       IF (ierr /= nf90_noerr) THEN
    145          PRINT*, 'Pb de lecture pour les sources dms bio'
    146          CALL exit(1)
    147       ENDIF
    148 c
    149 c Biologenic source of H2S
    150 c
    151       ierr = nf90_inq_varid (nid, "H2SB", nvarid)
    152       ierr = nf90_get_var(nid, nvarid, lmt_h2sbio_glo, debut, epais)
    153       IF (ierr /= nf90_noerr) THEN
    154          PRINT*, 'Pb de lecture pour les sources h2s bio'
    155          CALL exit(1)
    156       ENDIF
    157 c
    158 c Ocean surface concentration of dms (emissions are computed later)
    159 c
    160       IF (flag_dms==4) THEN
    161 c
     1SUBROUTINE condsurfs_new(jour, edgar, flag_dms, &
     2        lmt_so2b, lmt_so2h, lmt_so2nff, &
     3        lmt_so2bb_l, lmt_so2bb_h, lmt_so2ba, &
     4        lmt_so2volc_cont, lmt_altvolc_cont, &
     5        lmt_so2volc_expl, lmt_altvolc_expl, &
     6        lmt_dmsbio, lmt_h2sbio, lmt_dms, &
     7        lmt_dmsconc)
     8  USE mod_grid_phy_lmdz
     9  USE mod_phys_lmdz_para
     10  USE dimphy
     11  USE netcdf, ONLY : nf90_get_var, nf90_inq_varid, nf90_close, nf90_noerr, nf90_open, nf90_nowrite
     12  IMPLICIT none
     13
     14  ! Lire les conditions aux limites du modele pour la chimie.
     15  ! --------------------------------------------------------
     16
     17  INCLUDE "dimensions.h"
     18
     19  REAL :: lmt_so2b(klon), lmt_so2h(klon), lmt_so2nff(klon)
     20  REAL :: lmt_so2bb_l(klon), lmt_so2bb_h(klon)
     21  REAL :: lmt_dmsbio(klon), lmt_h2sbio(klon), lmt_so2ba(klon)
     22  REAL :: lmt_so2volc_cont(klon), lmt_altvolc_cont(klon)
     23  REAL :: lmt_so2volc_expl(klon), lmt_altvolc_expl(klon)
     24  REAL :: lmt_dms(klon), lmt_dmsconc(klon)
     25
     26  REAL :: lmt_so2b_glo(klon_glo), lmt_so2h_glo(klon_glo)
     27  REAL :: lmt_so2nff_glo(klon_glo)
     28  REAL :: lmt_so2bb_l_glo(klon_glo), lmt_so2bb_h_glo(klon_glo)
     29  REAL :: lmt_dmsbio_glo(klon_glo), lmt_h2sbio_glo(klon_glo)
     30  REAL :: lmt_so2ba_glo(klon_glo)
     31  REAL :: lmt_so2volc_cont_glo(klon_glo), lmt_altvolc_cont_glo(klon_glo)
     32  REAL :: lmt_so2volc_expl_glo(klon_glo), lmt_altvolc_expl_glo(klon_glo)
     33  REAL :: lmt_dms_glo(klon_glo), lmt_dmsconc_glo(klon_glo)
     34  LOGICAL :: edgar
     35  INTEGER :: flag_dms
     36
     37  INTEGER :: jour, i
     38  INTEGER :: ierr
     39  INTEGER :: nid, nvarid
     40  INTEGER :: debut(2), epais(2)
     41
     42  IF (jour<0 .OR. jour>(366 - 1)) THEN
     43    PRINT*, 'Le jour demande n est pas correcte:', jour
     44    print *, 'JE: FORCED TO CONTINUE (emissions have&
     45            & to be longer than 1 year!!!! )'
     46    ! CALL ABORT
     47  ENDIF
     48
     49  !$OMP MASTER
     50  IF (is_mpi_root .AND. is_omp_root) THEN
     51
     52    ! Tranche a lire:
     53    debut(1) = 1
     54    debut(2) = jour
     55    ! epais(1) = klon
     56    epais(1) = klon_glo
     57    epais(2) = 1
     58    !=======================================================================
     59    ! READING NEW EMISSIONS FROM RCP
     60    !=======================================================================
     61
     62    ierr = nf90_open ("sulphur_emissions_antro.nc", nf90_nowrite, nid)
     63    if (ierr/=nf90_noerr) then
     64      write(6, *)' Pb d''ouverture du fichier sulphur_emissions_antro'
     65      write(6, *)' ierr = ', ierr
     66      call exit(1)
     67    endif
     68
     69    ! SO2 Low level emissions
     70
     71    ierr = nf90_inq_varid (nid, "SO2FF_LOW", nvarid)
     72    ierr = nf90_get_var(nid, nvarid, lmt_so2b_glo, debut, epais)
     73    IF (ierr /= nf90_noerr) THEN
     74      PRINT*, 'Pb de lecture pour les sources so2 low'
     75      print *, 'JE klon, jour, debut ,epais ', klon_glo, jour, debut, epais
     76      CALL HANDLE_ERR(ierr)
     77      print *, 'error ierr= ', ierr
     78      CALL exit(1)
     79    ENDIF
     80
     81    ! SO2 High level emissions
     82
     83    ierr = nf90_inq_varid (nid, "SO2FF_HIGH", nvarid)
     84    ierr = nf90_get_var(nid, nvarid, lmt_so2h_glo, debut, epais)
     85    IF (ierr /= nf90_noerr) THEN
     86      PRINT*, 'Pb de lecture pour les sources so2 high'
     87      CALL exit(1)
     88    ENDIF
     89
     90    ! SO2 Biomass burning High level emissions
     91
     92    ierr = nf90_inq_varid (nid, "SO2BBH", nvarid)
     93    ierr = nf90_get_var(nid, nvarid, lmt_so2bb_h_glo, debut, epais)
     94    IF (ierr /= nf90_noerr) THEN
     95      PRINT*, 'Pb de lecture pour les sources so2 BB high'
     96      CALL exit(1)
     97    ENDIF
     98
     99    ! SO2 biomass burning low level emissions
     100
     101    ierr = nf90_inq_varid (nid, "SO2BBL", nvarid)
     102    ierr = nf90_get_var(nid, nvarid, lmt_so2bb_l_glo, debut, epais)
     103    IF (ierr /= nf90_noerr) THEN
     104      PRINT*, 'Pb de lecture pour les sources so2 BB low'
     105      CALL exit(1)
     106    ENDIF
     107
     108    ! SO2 ship emissions
     109
     110    ierr = nf90_inq_varid (nid, "SO2BA", nvarid)
     111    ierr = nf90_get_var(nid, nvarid, lmt_so2ba_glo, debut, epais)
     112    IF (ierr /= nf90_noerr) THEN
     113      PRINT*, 'Pb de lecture pour les sources so2 ship'
     114      CALL exit(1)
     115    ENDIF
     116
     117    ! SO2 Non Fossil Fuel Emissions
     118
     119    ierr = nf90_inq_varid (nid, "SO2NFF", nvarid)
     120    ierr = nf90_get_var(nid, nvarid, lmt_so2nff_glo, debut, epais)
     121    IF (ierr /= nf90_noerr) THEN
     122      PRINT*, 'Pb de lecture pour les sources so2 non FF'
     123      CALL exit(1)
     124    ENDIF
     125
     126    ierr = nf90_close(nid)
     127
     128    !=======================================================================
     129    ! READING NATURAL EMISSIONS
     130    !=======================================================================
     131    ierr = nf90_open ("sulphur_emissions_nat.nc", nf90_nowrite, nid)
     132    if (ierr/=nf90_noerr) then
     133      write(6, *)' Pb d''ouverture du fichier sulphur_emissions_nat'
     134      write(6, *)' ierr = ', ierr
     135      call exit(1)
     136    endif
     137
     138    ! Biologenic source of DMS
     139
     140    ierr = nf90_inq_varid (nid, "DMSB", nvarid)
     141    ierr = nf90_get_var(nid, nvarid, lmt_dmsbio_glo, debut, epais)
     142    IF (ierr /= nf90_noerr) THEN
     143      PRINT*, 'Pb de lecture pour les sources dms bio'
     144      CALL exit(1)
     145    ENDIF
     146
     147    ! Biologenic source of H2S
     148
     149    ierr = nf90_inq_varid (nid, "H2SB", nvarid)
     150    ierr = nf90_get_var(nid, nvarid, lmt_h2sbio_glo, debut, epais)
     151    IF (ierr /= nf90_noerr) THEN
     152      PRINT*, 'Pb de lecture pour les sources h2s bio'
     153      CALL exit(1)
     154    ENDIF
     155
     156    ! Ocean surface concentration of dms (emissions are computed later)
     157
     158    IF (flag_dms==4) THEN
     159
    162160      ierr = nf90_inq_varid (nid, "DMSC2", nvarid)
    163161      ierr = nf90_get_var(nid, nvarid, lmt_dmsconc_glo, debut, epais)
    164162      IF (ierr /= nf90_noerr) THEN
    165          PRINT*, 'Pb de lecture pour les sources dms conc 2'
    166          CALL exit(1)
     163        PRINT*, 'Pb de lecture pour les sources dms conc 2'
     164        CALL exit(1)
    167165      ENDIF
    168 c
    169       DO i=1, klon
    170 !        lmt_dms(i)=0.0
    171          lmt_dms_glo(i)=0.0
     166
     167      DO i = 1, klon
     168        ! lmt_dms(i)=0.0
     169        lmt_dms_glo(i) = 0.0
    172170      ENDDO
    173 c
    174       ELSE
    175 c
    176          PRINT *,'choix non possible pour flag_dms'
    177          STOP
    178 
    179       ENDIF
    180 c
    181       ierr = nf90_close(nid)
    182 c
    183 !=======================================================================
    184 !                      READING VOLCANIC EMISSIONS
    185 !=======================================================================
    186       print *,'   ***      READING VOLCANIC EMISSIONS   ***   '
    187       print *,' Jour = ',jour
    188       ierr = nf90_open ("sulphur_emissions_volc.nc", nf90_nowrite, nid)
    189       if (ierr/=nf90_noerr) then
    190         write(6,*)' Pb d''ouverture du fichier sulphur_emissions_volc'
    191         write(6,*)' ierr = ', ierr
    192         call exit(1)
    193       endif
    194 c
    195 c Continuous Volcanic emissions
    196 c
    197 !      ierr = nf90_inq_varid (nid, "VOLC", nvarid)
    198       ierr = nf90_inq_varid (nid, "flx_volc_cont", nvarid)
    199       ierr = nf90_get_var(nid, nvarid, lmt_so2volc_cont_glo, debut, epais)
    200       IF (ierr /= nf90_noerr) THEN
    201          PRINT*, 'Pb de lecture pour les sources so2 volcan (cont)'
    202          CALL exit(1)
    203       ENDIF
    204       print *,'SO2 volc cont (in read) = ',SUM(lmt_so2volc_cont_glo),
    205      +      MINVAL(lmt_so2volc_cont_glo),MAXVAL(lmt_so2volc_cont_glo)
    206 !      lmt_so2volc(:)=0.0
    207 c
    208 c Altitud of continuous volcanic emissions
    209 c
    210 !      ierr = nf90_inq_varid (nid, "ALTI", nvarid)
    211       ierr = nf90_inq_varid (nid, "flx_volc_altcont", nvarid)
    212       ierr = nf90_get_var(nid, nvarid, lmt_altvolc_cont_glo, debut, epais)
    213       IF (ierr /= nf90_noerr) THEN
    214          PRINT*, 'Pb de lecture pour les altitudes volcan (cont)'
    215          CALL exit(1)
    216       ENDIF
    217 c
    218 c Explosive Volcanic emissions
    219 c
    220       ierr = nf90_inq_varid (nid, "flx_volc_expl", nvarid)
    221       ierr = nf90_get_var(nid, nvarid, lmt_so2volc_expl_glo, debut, epais)
    222       IF (ierr /= nf90_noerr) THEN
    223          PRINT*, 'Pb de lecture pour les sources so2 volcan (expl)'
    224          CALL exit(1)
    225       ENDIF
    226 !      lmt_so2volc_expl(:)=0.0
    227       print *,'SO2 volc expl (in read) = ',SUM(lmt_so2volc_expl_glo),
    228      +      MINVAL(lmt_so2volc_expl_glo),MAXVAL(lmt_so2volc_expl_glo)
    229 c
    230 c Altitud of explosive volcanic emissions
    231 c
    232       ierr = nf90_inq_varid (nid, "flx_volc_altexpl", nvarid)
    233       ierr = nf90_get_var(nid, nvarid, lmt_altvolc_expl_glo, debut, epais)
    234       IF (ierr /= nf90_noerr) THEN
    235          PRINT*, 'Pb de lecture pour les altitudes volcan'
    236          CALL exit(1)
    237       ENDIF
    238 !      lmt_altvolc_expl(:)=0.0
    239 
    240       ierr = nf90_close(nid)
    241 c
    242       PRINT*, 'Sources SOUFRE lues pour jour: ', jour
    243 c
    244 
    245 
    246       ENDIF
    247 !$OMP END MASTER
    248 !$OMP BARRIER
    249       call scatter( lmt_so2b_glo        , lmt_so2b )
    250       call scatter(lmt_so2h_glo         , lmt_so2h ) 
    251       call scatter(lmt_so2bb_h_glo      , lmt_so2bb_h )
    252       call scatter(lmt_so2bb_l_glo      , lmt_so2bb_l)
    253       call scatter(lmt_so2ba_glo        , lmt_so2ba)
    254       call scatter(lmt_so2nff_glo       , lmt_so2nff)
    255       call scatter(lmt_dmsbio_glo       , lmt_dmsbio)
    256       call scatter(lmt_h2sbio_glo       , lmt_h2sbio)
    257       call scatter(lmt_dmsconc_glo      , lmt_dmsconc)
    258       call scatter(lmt_dms_glo          , lmt_dms)
    259       call scatter(lmt_so2volc_cont_glo , lmt_so2volc_cont)
    260       call scatter(lmt_altvolc_cont_glo , lmt_altvolc_cont)
    261       call scatter(lmt_so2volc_expl_glo , lmt_so2volc_expl)
    262       call scatter(lmt_altvolc_expl_glo , lmt_altvolc_expl)
    263 
    264 
    265       RETURN
    266       END
     171
     172    ELSE
     173
     174      PRINT *, 'choix non possible pour flag_dms'
     175      STOP
     176
     177    ENDIF
     178
     179    ierr = nf90_close(nid)
     180
     181    !=======================================================================
     182    !                  READING VOLCANIC EMISSIONS
     183    !=======================================================================
     184    print *, '   ***      READING VOLCANIC EMISSIONS   ***   '
     185    print *, ' Jour = ', jour
     186    ierr = nf90_open ("sulphur_emissions_volc.nc", nf90_nowrite, nid)
     187    if (ierr/=nf90_noerr) then
     188      write(6, *)' Pb d''ouverture du fichier sulphur_emissions_volc'
     189      write(6, *)' ierr = ', ierr
     190      call exit(1)
     191    endif
     192
     193    ! Continuous Volcanic emissions
     194
     195    !  ierr = nf90_inq_varid (nid, "VOLC", nvarid)
     196    ierr = nf90_inq_varid (nid, "flx_volc_cont", nvarid)
     197    ierr = nf90_get_var(nid, nvarid, lmt_so2volc_cont_glo, debut, epais)
     198    IF (ierr /= nf90_noerr) THEN
     199      PRINT*, 'Pb de lecture pour les sources so2 volcan (cont)'
     200      CALL exit(1)
     201    ENDIF
     202    print *, 'SO2 volc cont (in read) = ', SUM(lmt_so2volc_cont_glo), &
     203            MINVAL(lmt_so2volc_cont_glo), MAXVAL(lmt_so2volc_cont_glo)
     204    ! lmt_so2volc(:)=0.0
     205
     206    ! Altitud of continuous volcanic emissions
     207
     208    !  ierr = nf90_inq_varid (nid, "ALTI", nvarid)
     209    ierr = nf90_inq_varid (nid, "flx_volc_altcont", nvarid)
     210    ierr = nf90_get_var(nid, nvarid, lmt_altvolc_cont_glo, debut, epais)
     211    IF (ierr /= nf90_noerr) THEN
     212      PRINT*, 'Pb de lecture pour les altitudes volcan (cont)'
     213      CALL exit(1)
     214    ENDIF
     215
     216    ! Explosive Volcanic emissions
     217
     218    ierr = nf90_inq_varid (nid, "flx_volc_expl", nvarid)
     219    ierr = nf90_get_var(nid, nvarid, lmt_so2volc_expl_glo, debut, epais)
     220    IF (ierr /= nf90_noerr) THEN
     221      PRINT*, 'Pb de lecture pour les sources so2 volcan (expl)'
     222      CALL exit(1)
     223    ENDIF
     224    ! lmt_so2volc_expl(:)=0.0
     225    print *, 'SO2 volc expl (in read) = ', SUM(lmt_so2volc_expl_glo), &
     226            MINVAL(lmt_so2volc_expl_glo), MAXVAL(lmt_so2volc_expl_glo)
     227
     228    ! Altitud of explosive volcanic emissions
     229
     230    ierr = nf90_inq_varid (nid, "flx_volc_altexpl", nvarid)
     231    ierr = nf90_get_var(nid, nvarid, lmt_altvolc_expl_glo, debut, epais)
     232    IF (ierr /= nf90_noerr) THEN
     233      PRINT*, 'Pb de lecture pour les altitudes volcan'
     234      CALL exit(1)
     235    ENDIF
     236    ! lmt_altvolc_expl(:)=0.0
     237
     238    ierr = nf90_close(nid)
     239
     240    PRINT*, 'Sources SOUFRE lues pour jour: ', jour
     241
     242  ENDIF
     243  !$OMP END MASTER
     244  !$OMP BARRIER
     245  call scatter(lmt_so2b_glo, lmt_so2b)
     246  call scatter(lmt_so2h_glo, lmt_so2h)
     247  call scatter(lmt_so2bb_h_glo, lmt_so2bb_h)
     248  call scatter(lmt_so2bb_l_glo, lmt_so2bb_l)
     249  call scatter(lmt_so2ba_glo, lmt_so2ba)
     250  call scatter(lmt_so2nff_glo, lmt_so2nff)
     251  call scatter(lmt_dmsbio_glo, lmt_dmsbio)
     252  call scatter(lmt_h2sbio_glo, lmt_h2sbio)
     253  call scatter(lmt_dmsconc_glo, lmt_dmsconc)
     254  call scatter(lmt_dms_glo, lmt_dms)
     255  call scatter(lmt_so2volc_cont_glo, lmt_so2volc_cont)
     256  call scatter(lmt_altvolc_cont_glo, lmt_altvolc_cont)
     257  call scatter(lmt_so2volc_expl_glo, lmt_so2volc_expl)
     258  call scatter(lmt_altvolc_expl_glo, lmt_altvolc_expl)
     259
     260  RETURN
     261END SUBROUTINE condsurfs_new

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/dustemission_mod.F90

    r5087 r5099  
    466466!  emdustsco(k)=auxr3*tuningfactor
    467467!enddo
    468 !
    469 
    470 
    471 
    472468
    473469!JEdbg<<
    … …  
    904900if (1==1) then
    905901!  !  CALL writefield_phy("AA",tmp1(1:klon,1:5),5)
    906 !
     902
    907903    CALL writefield_phy("REPART5",feff(1:klon,1:5),5)
    908904    CALL writefield_phy("REPART5dbg",feffdbg(1:klon,1:5),5)
    … …  
    925921!  if (.false.) then
    926922!!**************L718
    927 !
     923
    928924!!c------------------------------------------------------------------------
    929925!! isolog distrib and massfrac calculations.
    930 !
     926
    931927!      nbinsout=nbins+1
    932928!      b1=log(sizedustmin)
    933929!      b2=log(sizedustmax)
    934930!! restricted ISOLOG bins distributions
    935 !
     931
    936932!!      step=(b2-b1)/(nbinsout-1)
    937933!!      DO ni=1,nbinsout
    … …  
    945941!     binsHR(nb)=exp(b1+(nb-1)*stepbin)
    946942!  END DO
    947 !
     943
    948944!  DO nb=1,nbinsHR
    949945!     binsHRcm(nb)=binsHR(nb)*1.e-4
    … …  
    951947!! Making HIGH RESOLUTION dry deposition velocity
    952948!     CALL calcvd(vdout)
    953 !
    954 !
     949
     950
    955951! DO nb=1,nbinsHR
    956952!     vdHR(nb)=vdout(nb)
    957953!!  WRITE(18,*),binsHR(nb),vdHR(nb)
    958954!  END DO
    959 !
     955
    960956!   !searching for minimum value of dry deposition velocity
    961957!  minisograd=1.e20
    … …  
    966962!     END IF
    967963!  END DO
    968 !
     964
    969965!! searching for optimal number of bins in positive slope Vd part
    970 !
     966
    971967!  nbins1=1
    972968!  nbins2=nbinsout-1
    … …  
    976972!        IF(delta2.GE.delta1)THEN
    977973!        GOTO 50
    978 !
     974
    979975!        ELSE
    980976!           nbins2=nbins2-1
    … …  
    994990!     logvdISOGRAD(k)=logvdISOGRAD(1)-(k-1)*delta1
    995991!  END DO
    996 !
     992
    997993!  logvdISOGRAD(nbins1+1)=log(minisograd)
    998 !
     994
    999995!  DO k=1,nbins2
    1000996!     logvdISOGRAD(nbins1+1+k)=logvdISOGRAD(nbins1+1)+k*delta2
    1001997!  END DO
    1002 !
     998
    1003999!  DO k=1,nbinsout
    10041000!     vdISOGRAD(k)=exp(logvdISOGRAD(k))
    … …  
    10401036
    10411037! Making dust size distribution (in um)
    1042 !
     1038
    10431039      nbinsout=nbins+1
    10441040      b1=log(sizedustmin)
    … …  
    10531049!     binsHR(nb)=exp(b1+(nb-1)*stepbin)
    10541050!  END DO
    1055 !
     1051
    10561052!  DO nb=1,nbinsHR
    10571053!     binsHRcm(nb)=binsHR(nb)*1.e-4
    … …  
    11881184!  print
    11891185!*,'zwstar=sqrt(2.*(',flag_wstarBL,'ale_bl+0.01*(',flag_wstar,'-100)*ale_wake))'
    1190   !
     1186
    11911187    DO i=1,klon  ! main loop
    11921188     zwstar(i)=sqrt(2.*(param_wstarBL(i)*ale_bl(i)+param_wstarWAKE(i)*ale_wake(i)))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/inscav_spl.F

    r5082 r5099  
    102102! fluxes are defined on klev levels only.
    103103! NHL
    104 !
     104
    105105      flxr_aux(:,klev+1)=0.0
    106106      flxs_aux(:,klev+1)=0.0

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/kg_to_cm3.f90

    r5098 r5099  
    1       SUBROUTINE kg_to_cm3(pplay,t_seri,tr_seri)
    2 c     
    3       USE dimphy
    4       USE infotrac
    5       IMPLICIT NONE
    6 c
    7       INCLUDE "dimensions.h"
    8       INCLUDE "YOMCST.h"
    9 c     
    10       REAL t_seri(klon,klev), pplay(klon,klev)
    11       REAL tr_seri(klon,klev)
    12       REAL zrho
    13       INTEGER i, k
    14 c
    15       DO k = 1, klev
    16       DO i = 1, klon
    17         zrho=pplay(i,k)/t_seri(i,k)/RD
    18         tr_seri(i,k)=tr_seri(i,k)/1.e6*zrho
    19       ENDDO
    20       ENDDO
    21 c
    22       END
     1SUBROUTINE kg_to_cm3(pplay, t_seri, tr_seri)
     2
     3  USE dimphy
     4  USE infotrac
     5  IMPLICIT NONE
     6
     7  INCLUDE "dimensions.h"
     8  INCLUDE "YOMCST.h"
     9
     10  REAL :: t_seri(klon, klev), pplay(klon, klev)
     11  REAL :: tr_seri(klon, klev)
     12  REAL :: zrho
     13  INTEGER :: i, k
     14
     15  DO k = 1, klev
     16    DO i = 1, klon
     17      zrho = pplay(i, k) / t_seri(i, k) / RD
     18      tr_seri(i, k) = tr_seri(i, k) / 1.e6 * zrho
     19    ENDDO
     20  ENDDO
     21
     22END SUBROUTINE kg_to_cm3

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_orig.F90

    r5082 r5099  
    1010  USE traclmdz_mod
    1111  USE infotrac,ONLY : nbtr
    12 !!!  USE geometry_mod
    1312  USE iophy
     13  USE lmdz_yomcst
    1414
    1515  IMPLICIT NONE
    … …  
    2323  include "dimensions.h"
    2424  include "chem.h"
    25   include "YOMCST.h"
    26   include "YOECUMF.h"
     25  include "YOECUMF.h"
    2726
    2827  REAL,INTENT(IN)                        :: pdtime ! time step (s)
    … …  
    5352 LOGICAL,SAVE :: debut=.true.
    5453!$OMP THREADPRIVATE(debut)
    55 !
     54
    5655  REAL,PARAMETER :: henry=1.4  ! constante de Henry en mol/l/atm ~1.4 for gases
    5756  REAL           :: henry_t    !  constante de Henry a T t  (mol/l/atm)
    … …  
    8988  REAL           :: pr, ps, ice, water
    9089  real :: conserv
    91 !
     90
    9291!!!!!!!!!!!!!!!!!!!! choix lessivage !!!!!!!!!!!!!!!!!!!!!!!!
    9392!!  logical,save  :: inscav_fisrt
    9493!!! $OMP THREADPRIVATE(inscav_first)
    95 !
     94
    9695!!!!!!!!!!!!!!!!!!!!!!!!!!!
    9796  IF (debut) THEN
    98 !
     97
    9998!  inscav_fisrt=.true.
    10099!  call getin('inscav_fisrt',inscav_fisrt)
    … …  
    104103!   print*,'beta from Reddy and Bocuher 2004 (original version), inscav_fisrt=',inscav_fisrt
    105104!  endif
    106 !
     105
    107106      alpha_r=0.001        !  coefficient d'impaction pour la pluie
    108107      alpha_s=0.01         !  coefficient d'impaction pour la neige 
    … …  
    113112!     frac_aer=0.5 ~ droplet size shrinks by evap
    114113      frac_aer=0.5
    115 !
    116114
    117115!JE to speed up, commented 20140219
    118 !
     116
    119117!      OPEN(99,file='lsc_scav_param.data',status='old', &
    120118!                form='formatted',err=9999)
    … …  
    129127!      CLOSE(99)
    130128!9999  Continue
    131 !
     129
    132130!   print*,'alpha_r',alpha_r
    133131!   print*,'alpha_s',alpha_s
    … …  
    137135!   print*,'frac_coar_scav',frac_coar_scav
    138136!   print*,'frac_aer ev',frac_aer
    139 !
     137
    140138! JE endcomment
    141 !
     139
    142140  ENDIF !(debut)
    143141!!!!!!!!!!!!!!!!!!!!!!!!!!!
    144 !
     142
    145143! initialization
    146144  dxin=0.
    … …  
    212210   endif ! (iflag_lscav .eq. 4)
    213211   beta_v1(i,k)=beta    !! for output
    214 !
     212
    215213      dxin=tr_seri(i,k,it)*(exp(-scav(i,k)*beta*pdtime)-1.)
    216214!      his_dh(i)=his_dh(i)-dxin*zrho(i,k)*zdz(i,k)/pdtime !  kg/m2/s

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lsc_scav_spl.F90

    r5082 r5099  
    1212  USE traclmdz_mod
    1313  USE infotrac,ONLY : nbtr
    14 !  USE comgeomphy
    1514  USE iophy
     15  USE lmdz_yomcst
    1616  IMPLICIT NONE
    1717!=====================================================================
    … …  
    2525  include "dimensions.h"
    2626  include "chem.h"
    27   include "YOMCST.h"
    28   include "YOECUMF.h"
     27  include "YOECUMF.h"
    2928
    3029  REAL,INTENT(IN)                        :: pdtime ! time step (s)
    … …  
    5655 LOGICAL,SAVE :: debut=.true.
    5756!$OMP THREADPRIVATE(debut)
    58 !
     57
    5958!JE  REAL,PARAMETER :: henry=1.4  ! constante de Henry en mol/l/atm ~1.4 for gases
    6059  REAL,DIMENSION(nbtr) :: henry  ! constante de Henry en mol/l/atm ~1.4 for gases
    … …  
    9998  REAL           :: pr, ps, ice, water
    10099  real :: conserv
    101 !
     100
    102101!!!!!!!!!!!!!!!!!!!! choix lessivage !!!!!!!!!!!!!!!!!!!!!!!!
    103102!!  logical,save  :: inscav_fisrt
    104103!!! $OMP THREADPRIVATE(inscav_first)
    105 !
     104
    106105!!!!!!!!!!!!!!!!!!!!!!!!!!!
    107106  IF (debut) THEN
    108 !
     107
    109108!  inscav_fisrt=.true.
    110109!  call getin('inscav_fisrt',inscav_fisrt)
    … …  
    114113!   print*,'beta from Reddy and Bocuher 2004 (original version), inscav_fisrt=',inscav_fisrt
    115114!  endif
    116 !
     115
    117116!JE      alpha_r=0.001        !  coefficient d'impaction pour la pluie
    118117!JE      alpha_s=0.01         !  coefficient d'impaction pour la neige 
    … …  
    123122!     frac_aer=0.5 ~ droplet size shrinks by evap
    124123      frac_aer=0.5
    125 !
    126124
    127125!JE to speed up, commented 20140219
    128 !
     126
    129127!      OPEN(99,file='lsc_scav_param.data',status='old', &
    130128!                form='formatted',err=9999)
    … …  
    139137!      CLOSE(99)
    140138!9999  Continue
    141 !
     139
    142140!   print*,'JE alpha_r',alpha_r
    143141!   print*,'JE alpha_s',alpha_s
    … …  
    147145!   print*,'frac_coar_scav',frac_coar_scav
    148146!   print*,'frac_aer ev',frac_aer
    149 !
     147
    150148! JE endcomment
    151 !
     149
    152150  ENDIF !(debut)
    153151!!!!!!!!!!!!!!!!!!!!!!!!!!!
    154 !
     152
    155153! initialization
    156154  dxin=0.
    … …  
    223221   endif ! (iflag_lscav .eq. 4)
    224222   beta_v1(i,k)=beta    !! for output
    225 !
     223
    226224      dxin=tr_seri(i,k,it)*(exp(-scav(i,k)*beta*pdtime)-1.)
    227225!      his_dh(i)=his_dh(i)-dxin*zrho(i,k)*zdz(i,k)/pdtime !  kg/m2/s

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phys_output_write_spl_mod.F90

    r5088 r5099  
    1 !
     1
    22! $Id: phys_output_write_mod.F90 2298 2015-06-14 19:13:32Z fairhead $
    3 !
     3
    44MODULE phys_output_write_spl_mod
    55
    … …  
    395395    USE wxios, ONLY: wxios_closedef, missing_val_xios => missing_val
    396396    USE phys_cal_mod, ONLY : mth_len
     397    USE lmdz_yomcst
    397398
    398399    IMPLICIT NONE
    … …  
    402403    INCLUDE "alpale.h"
    403404    INCLUDE "compbl.h"
    404     INCLUDE "YOMCST.h"
    405405    INCLUDE "dimensions.h"
    406406    include "iniprint.h"

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phytracr_spl_mod.F90

    r5088 r5099  
    44MODULE phytracr_spl_mod
    55
    6 ! Recuperation des morceaux de la physique de Jeronimo specifiques
    7 ! du modele d'aerosols d'Olivier n'co.
    8 !
    9 INCLUDE "chem.h"
    10 INCLUDE "chem_spla.h"
    11 
    12   REAL,SAVE  :: scale_param_ssacc  !Scaling parameter for Fine Sea Salt
    13   REAL,SAVE ::  scale_param_sscoa  !Scaling parameter for Coarse Sea Salt
    14 
    15 
    16 
    17   REAL, DIMENSION(:),ALLOCATABLE,SAVE :: scale_param_ind !Scaling parameter for industrial emissions of SO2
    18   REAL, DIMENSION(:),ALLOCATABLE,SAVE :: scale_param_bb  !Scaling parameter for biomas burning (SO2,BC & OM)
    19   REAL, DIMENSION(:),ALLOCATABLE,SAVE :: scale_param_ff  !Scaling parameter for industrial emissions (fossil fuel)
    20   REAL, DIMENSION(:),ALLOCATABLE,SAVE :: scale_param_dustacc  !Scaling parameter for Fine Dust
    21   REAL, DIMENSION(:),ALLOCATABLE,SAVE :: scale_param_dustcoa  !Scaling parameter for Coarse Dust
    22   REAL, DIMENSION(:),ALLOCATABLE,SAVE :: scale_param_dustsco  !Scaling parameter for SCoarse Dust
    23   REAL, DIMENSION(:),ALLOCATABLE,SAVE :: param_wstarBLperregion  !parameter for ..
    24   REAL, DIMENSION(:),ALLOCATABLE,SAVE :: param_wstarWAKEperregion  !parameter for ..
     6  ! Recuperation des morceaux de la physique de Jeronimo specifiques
     7  ! du modele d'aerosols d'Olivier n'co.
     8
     9  INCLUDE "chem.h"
     10  INCLUDE "chem_spla.h"
     11
     12  REAL, SAVE :: scale_param_ssacc  !Scaling parameter for Fine Sea Salt
     13  REAL, SAVE :: scale_param_sscoa  !Scaling parameter for Coarse Sea Salt
     14
     15  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_ind !Scaling parameter for industrial emissions of SO2
     16  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_bb  !Scaling parameter for biomas burning (SO2,BC & OM)
     17  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_ff  !Scaling parameter for industrial emissions (fossil fuel)
     18  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_dustacc  !Scaling parameter for Fine Dust
     19  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_dustcoa  !Scaling parameter for Coarse Dust
     20  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_dustsco  !Scaling parameter for SCoarse Dust
     21  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: param_wstarBLperregion  !parameter for ..
     22  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: param_wstarWAKEperregion  !parameter for ..
    2523  !$OMP THREADPRIVATE(scale_param_ind,scale_param_bb,scale_param_ff)
    2624  !$OMP THREADPRIVATE(scale_param_dustacc,scale_param_dustcoa,scale_param_dustsco)
    2725  !$OMP THREADPRIVATE(scale_param_ssacc,scale_param_sscoa)
    2826  !$OMP THREADPRIVATE(param_wstarBLperregion,param_wstarWAKEperregion)
    29   REAL, DIMENSION(:),ALLOCATABLE,SAVE ::dust_ec, u10m_ec, v10m_ec
    30 !$OMP THREADPRIVATE(dust_ec, u10m_ec, v10m_ec)
     27  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dust_ec, u10m_ec, v10m_ec
     28  !$OMP THREADPRIVATE(dust_ec, u10m_ec, v10m_ec)
    3129
    3230  CHARACTER*800 fileregionsdimsind
    … …  
    4543  CHARACTER*100 paramname_wstarWAKE
    4644
    47 
    4845  CHARACTER*800 filescaleparams
    4946  CHARACTER*800 paramsname
    … …  
    5148
    5249  !!------------------------ SULFUR emissions ----------------------------
    53   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2volc_cont  ! emissions so2 volcan continuous
    54   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_altvolc_cont  ! altitude  so2 volcan continuous
    55   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2volc_expl  ! emissions so2 volcan explosive
    56 !$OMP THREADPRIVATE( lmt_so2volc_cont,lmt_altvolc_cont,lmt_so2volc_expl )
    57   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_altvolc_expl  ! altitude  so2 volcan explosive
    58   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2ff_l       ! emissions so2 fossil fuel (low)
    59   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2ff_h       ! emissions so2 fossil fuel (high)
    60 !$OMP THREADPRIVATE( lmt_altvolc_expl,lmt_so2ff_l,lmt_so2ff_h )
    61   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2nff        ! emissions so2 non-fossil fuel
    62   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2ba         ! emissions de so2 bateau
    63   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2bb_l       ! emissions de so2 biomass burning (low)
    64 !$OMP THREADPRIVATE( lmt_so2nff,lmt_so2ba,lmt_so2bb_l )
    65   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2bb_h       ! emissions de so2 biomass burning (high)
    66   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_dmsconc       ! concentration de dms oceanique
    67   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_dmsbio        ! emissions de dms bio
    68   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_h2sbio        ! emissions de h2s bio
    69 !$OMP THREADPRIVATE(lmt_so2bb_h,lmt_dmsconc,lmt_dmsbio,lmt_h2sbio )
     50  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2volc_cont  ! emissions so2 volcan continuous
     51  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_altvolc_cont  ! altitude  so2 volcan continuous
     52  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2volc_expl  ! emissions so2 volcan explosive
     53  !$OMP THREADPRIVATE( lmt_so2volc_cont,lmt_altvolc_cont,lmt_so2volc_expl )
     54  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_altvolc_expl  ! altitude  so2 volcan explosive
     55  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2ff_l       ! emissions so2 fossil fuel (low)
     56  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2ff_h       ! emissions so2 fossil fuel (high)
     57  !$OMP THREADPRIVATE( lmt_altvolc_expl,lmt_so2ff_l,lmt_so2ff_h )
     58  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2nff        ! emissions so2 non-fossil fuel
     59  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2ba         ! emissions de so2 bateau
     60  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2bb_l       ! emissions de so2 biomass burning (low)
     61  !$OMP THREADPRIVATE( lmt_so2nff,lmt_so2ba,lmt_so2bb_l )
     62  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2bb_h       ! emissions de so2 biomass burning (high)
     63  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_dmsconc       ! concentration de dms oceanique
     64  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_dmsbio        ! emissions de dms bio
     65  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_h2sbio        ! emissions de h2s bio
     66  !$OMP THREADPRIVATE(lmt_so2bb_h,lmt_dmsconc,lmt_dmsbio,lmt_h2sbio )
    7067  !------------------------- BLACK CARBON emissions ----------------------
    71   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_bcff       ! emissions de BC fossil fuels
    72   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_bcnff      ! emissions de BC non-fossil fuels
    73   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_bcbb_l     ! emissions de BC biomass basses
    74 !$OMP THREADPRIVATE( lmt_bcff,lmt_bcnff,lmt_bcbb_l)
    75   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_bcbb_h     ! emissions de BC biomass hautes
    76   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_bcba       ! emissions de BC bateau
    77 !$OMP THREADPRIVATE(lmt_bcbb_h,lmt_bcba)
     68  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_bcff       ! emissions de BC fossil fuels
     69  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_bcnff      ! emissions de BC non-fossil fuels
     70  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_bcbb_l     ! emissions de BC biomass basses
     71  !$OMP THREADPRIVATE( lmt_bcff,lmt_bcnff,lmt_bcbb_l)
     72  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_bcbb_h     ! emissions de BC biomass hautes
     73  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_bcba       ! emissions de BC bateau
     74  !$OMP THREADPRIVATE(lmt_bcbb_h,lmt_bcba)
    7875  !------------------------ ORGANIC MATTER emissions ---------------------
    79   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_omff     ! emissions de OM fossil fuels
    80   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_omnff    ! emissions de OM non-fossil fuels
    81   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_ombb_l   ! emissions de OM biomass basses
    82 !$OMP THREADPRIVATE( lmt_omff,lmt_omnff,lmt_ombb_l)
    83   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_ombb_h   ! emissions de OM biomass hautes
    84   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_omnat    ! emissions de OM Natural
    85   REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_omba     ! emissions de OM bateau
    86   REAL , DIMENSION(:,:),ALLOCATABLE,SAVE :: lmt_sea_salt    ! emissions de OM Natural
    87 !$OMP THREADPRIVATE(lmt_ombb_h,lmt_omnat,lmt_omba,lmt_sea_salt)
    88 
    89 !JE20141224 >>
     76  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_omff     ! emissions de OM fossil fuels
     77  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_omnff    ! emissions de OM non-fossil fuels
     78  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_ombb_l   ! emissions de OM biomass basses
     79  !$OMP THREADPRIVATE( lmt_omff,lmt_omnff,lmt_ombb_l)
     80  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_ombb_h   ! emissions de OM biomass hautes
     81  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_omnat    ! emissions de OM Natural
     82  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_omba     ! emissions de OM bateau
     83  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: lmt_sea_salt    ! emissions de OM Natural
     84  !$OMP THREADPRIVATE(lmt_ombb_h,lmt_omnat,lmt_omba,lmt_sea_salt)
     85
     86  !JE20141224 >>
    9087  ! others
    91   REAL, DIMENSION(:),ALLOCATABLE,SAVE :: tsol
    92 !$OMP THREADPRIVATE(tsol)
     88  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: tsol
     89  !$OMP THREADPRIVATE(tsol)
    9390  INTEGER :: ijulday
    94   LOGICAL , parameter :: edgar = .true.
    95   INTEGER , parameter :: flag_dms=4
    96   INTEGER(kind=4)  nbjour
    97 
    98       !
    99 ! Tracer tendencies, for outputs
    100 !-------------------------------
    101       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cl  ! Td couche
    102 !. limite/traceur
    103       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_dec
    104 !RomP
    105       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cv  ! Td
    106 !onvection/traceur
    107 ! RomP >>>
    108       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_insc
    109       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_bcscav
    110       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_evapls
    111       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_ls
    112       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_trsp
    113       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sscav
    114       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sat
    115       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_uscav
    116       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPr,qDi ! concentration tra
    117 !dans pluie,air descente insaturee
    118       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPa,qMel
    119       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qTrdi,dtrcvMA ! conc traceur
    120 !descente air insaturee et td convective MA
    121 !! RomP <<<
    122       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_th  ! Td thermique
    123       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_lessi_impa ! Td du
    124 !lessivage par impaction
    125       REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_lessi_nucl ! Td du
    126 !lessivage par nucleation
    127       REAL,DIMENSION(:,:),ALLOCATABLE,SAVE      :: qPrls      !jyg:
    128 !oncentration tra dans pluie LS a la surf.
    129       REAL,DIMENSION(:,:),ALLOCATABLE,SAVE      :: d_tr_dry ! Td depot
    130 !sec/traceur (1st layer),ALLOCATABLE,SAVE  jyg
    131       REAL,DIMENSION(:,:),ALLOCATABLE,SAVE      :: flux_tr_dry ! depot
    132 !sec/traceur (surface),ALLOCATABLE,SAVE    jyg
    133 
    134 ! Index of each traceur
    135       INTEGER,SAVE :: id_prec, id_fine, id_coss, id_codu, id_scdu
    136 
    137 !$OMP THREADPRIVATE(d_tr_cl,d_tr_dec,d_tr_cv,d_tr_insc,d_tr_bcscav,d_tr_evapls)
    138 !$OMP THREADPRIVATE(d_tr_ls,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav)
    139 !$OMP THREADPRIVATE(qPr,qDi,qPa,qMel,qTrdi,dtrcvMA,d_tr_th,d_tr_lessi_impa)
    140 !$OMP THREADPRIVATE(d_tr_lessi_nucl,qPrls,d_tr_dry,flux_tr_dry)
    141 !$OMP THREADPRIVATE(id_prec,id_fine,id_coss,id_codu,id_scdu)
    142 
    143 ! JE20141224 <<
    144 
    145       REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diff_aod550_tot  ! epaisseur optique total aerosol 550  nm
    146       REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod670_tot  ! epaisseur optique total aerosol 670 nm
    147       REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod865_tot  ! epaisseur optique total aerosol 865 nm
    148       REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diff_aod550_tr2  ! epaisseur optique Traceur 2 aerosol 550 nm, diagnostic
    149       REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod670_tr2  ! epaisseur optique Traceur 2 aerosol 670 nm, diagnostic
    150       REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod865_tr2  ! epaisseur optique Traceur 2 aerosol 865 nm, diagnostic
    151       REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod550_ss  ! epaisseur optique Sels marins aerosol 550 nm, diagnostic
    152       REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod670_ss  ! epaisseur optique Sels marins aerosol 670 nm, diagnostic
    153       REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod865_ss   ! epaisseur optique Sels marins aerosol 865 nm, diagnostic
    154       REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod550_dust ! epaisseur optique Dust aerosol 550 nm, diagnostic
    155       REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod670_dust ! epaisseur optique Dust aerosol 670 nm, diagnostic
    156       REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod865_dust ! epaisseur optique Dust aerosol 865 nm, diagnostic
    157       REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod550_dustsco ! epaisseur optique Dust SCOarse aerosol 550 nm, diagnostic
    158       REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod670_dustsco ! epaisseur optique Dust SCOarse aerosol 670 nm, diagnostic
    159       REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod865_dustsco ! epaisseur optique Dust SCOarse aerosol 865 nm, diagnostic
    160 
    161 !$OMP THREADPRIVATE(diff_aod550_tot,diag_aod670_tot,diag_aod865_tot)
    162 !$OMP THREADPRIVATE(diff_aod550_tr2,diag_aod670_tr2,diag_aod865_tr2)
    163 !$OMP THREADPRIVATE(diag_aod550_ss,diag_aod670_ss,diag_aod865_ss,diag_aod550_dust)
    164 !$OMP THREADPRIVATE(diag_aod670_dust,diag_aod865_dust,diag_aod550_dustsco)
    165 !$OMP THREADPRIVATE(diag_aod670_dustsco,diag_aod865_dustsco)
    166 
    167 
    168       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_terra  ! AOD at terra overpass time ( 10.30 local hour)
    169       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_tr2_terra  ! AOD at terra overpass time ( 10.30 local hour)
    170       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_ss_terra  ! AOD at terra overpass time ( 10.30 local hour)
    171       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dust_terra  ! AOD at terra overpass time ( 10.30 local hour)
    172       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dustsco_terra  ! AOD at terra overpass time ( 10.30 local hour)
    173       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_terra  ! AOD at terra overpass time ( 10.30 local hour)
    174       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_tr2_terra  ! AOD at terra overpass time ( 10.30 local hour)
    175       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_ss_terra  ! AOD at terra overpass time ( 10.30 local hour)
    176       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dust_terra  ! AOD at terra overpass time ( 10.30 local hour)
    177       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dustsco_terra  ! AOD at terra overpass time ( 10.30 local hour)
    178       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_terra  ! AOD at terra overpass time ( 10.30 local hour)
    179       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_tr2_terra  ! AOD at terra overpass time ( 10.30 local hour)
    180       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_ss_terra  ! AOD at terra overpass time ( 10.30 local hour)
    181       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dust_terra  ! AOD at terra overpass time ( 10.30 local hour)
    182       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dustsco_terra  ! AOD at terra overpass time ( 10.30 local hour)
    183 
    184 
    185       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
    186       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_tr2_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
    187       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_ss_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
    188       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dust_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
    189       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dustsco_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
    190       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
    191       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_tr2_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
    192       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_ss_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
    193       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dust_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
    194       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dustsco_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
    195       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
    196       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_tr2_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
    197       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_ss_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
    198       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dust_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
    199       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dustsco_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
    200 
    201 !$OMP THREADPRIVATE(aod550_aqua,aod550_tr2_aqua,aod550_ss_aqua,aod550_dust_aqua,aod550_dustsco_aqua)
    202 !$OMP THREADPRIVATE(aod670_aqua,aod670_tr2_aqua,aod670_ss_aqua,aod670_dust_aqua,aod670_dustsco_aqua)
    203 !$OMP THREADPRIVATE(aod865_aqua,aod865_tr2_aqua,aod865_ss_aqua,aod865_dust_aqua,aod865_dustsco_aqua)
    204 !$OMP THREADPRIVATE(aod550_terra,aod550_tr2_terra,aod550_ss_terra,aod550_dust_terra,aod550_dustsco_terra)
    205 !$OMP THREADPRIVATE(aod670_terra,aod670_tr2_terra,aod670_ss_terra,aod670_dust_terra,aod670_dustsco_terra)
    206 !$OMP THREADPRIVATE(aod865_terra,aod865_tr2_terra,aod865_ss_terra,aod865_dust_terra,aod865_dustsco_terra)
    207 
    208 
    209       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc01 ! surface concentration
    210       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm01   ! burden
    211       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc02 ! surface concentration
    212       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm02   ! burden
    213       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc03 ! surface concentration
    214       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm03   ! burden
    215       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc04 ! surface concentration
    216       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm04   ! burden
    217       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc05 ! surface concentration
    218       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm05   ! burden
    219 !$OMP THREADPRIVATE(sconc01,sconc02,sconc03,sconc04,sconc05)
    220 !$OMP THREADPRIVATE(trm01,trm02,trm03,trm04,trm05)
    221       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux01       
    222       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux02       
    223       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux03       
    224       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux04       
    225       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux05       
    226 !$OMP THREADPRIVATE(flux01,flux02,flux03,flux04,flux05)
    227       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds01         
    228       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds02         
    229       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds03         
    230       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds04         
    231       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds05         
    232 !$OMP THREADPRIVATE(ds01,ds02,ds03,ds04,ds05)
    233       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh01         
    234       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh02         
    235       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh03         
    236       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh04         
    237       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh05         
    238 !$OMP THREADPRIVATE(dh01,dh02,dh03,dh04,dh05)
    239       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv01   
    240       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv02   
    241       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv03   
    242       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv04   
    243       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv05   
    244 !$OMP THREADPRIVATE(dtrconv01,dtrconv02,dtrconv03,dtrconv04,dtrconv05)
    245       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm01     
    246       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm02     
    247       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm03     
    248       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm04     
    249       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm05     
    250 !$OMP THREADPRIVATE(dtherm01,dtherm02,dtherm03,dtherm04,dtherm05)
    251       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv01     
    252       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv02     
    253       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv03     
    254       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv04     
    255       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv05     
    256 !$OMP THREADPRIVATE(dhkecv01,dhkecv02,dhkecv03,dhkecv04,dhkecv05)
    257       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds01     
    258       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds02     
    259       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds03     
    260       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds04     
    261       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds05     
    262 !$OMP THREADPRIVATE(d_tr_ds01,d_tr_ds02,d_tr_ds03,d_tr_ds04,d_tr_ds05)
    263       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc01   
    264       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc02   
    265       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc03   
    266       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc04   
    267       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc05   
    268 !$OMP THREADPRIVATE(dhkelsc01,dhkelsc02,dhkelsc03,dhkelsc04,dhkelsc05)
    269       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cv01   
    270       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cv02   
    271       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cv03   
    272       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cv04   
    273       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cv05   
    274 !$OMP THREADPRIVATE(d_tr_cv01,d_tr_cv02,d_tr_cv03,d_tr_cv04,d_tr_cv05)
    275       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_trsp01 
    276       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_trsp02 
    277       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_trsp03 
    278       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_trsp04 
    279       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_trsp05 
    280 !$OMP THREADPRIVATE(d_tr_trsp01,d_tr_trsp02,d_tr_trsp03,d_tr_trsp04,d_tr_trsp05)
    281       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sscav01
    282       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sscav02
    283       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sscav03
    284       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sscav04
    285       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sscav05
    286 !$OMP THREADPRIVATE(d_tr_sscav01,d_tr_sscav02,d_tr_sscav03,d_tr_sscav04,d_tr_sscav05)
    287       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sat01   
    288       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sat02   
    289       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sat03   
    290       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sat04   
    291       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sat05   
    292 !$OMP THREADPRIVATE(d_tr_sat01,d_tr_sat02,d_tr_sat03,d_tr_sat04,d_tr_sat05)
    293       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_uscav01
    294       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_uscav02
    295       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_uscav03
    296       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_uscav04
    297       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_uscav05
    298 !$OMP THREADPRIVATE(d_tr_uscav01,d_tr_uscav02,d_tr_uscav03,d_tr_uscav04,d_tr_uscav05)
    299 
    300 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    301 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    302 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    303 
    304       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_insc01 
    305       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_insc02 
    306       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_insc03 
    307       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_insc04 
    308       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_insc05 
    309 !$OMP THREADPRIVATE(d_tr_insc01,d_tr_insc02,d_tr_insc03,d_tr_insc04,d_tr_insc05)
    310       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_bcscav01
    311       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_bcscav02
    312       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_bcscav03
    313       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_bcscav04
    314       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_bcscav05
    315 !$OMP THREADPRIVATE(d_tr_bcscav01,d_tr_bcscav02,d_tr_bcscav03,d_tr_bcscav04,d_tr_bcscav05)
    316       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_evapls01   
    317       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_evapls02   
    318       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_evapls03   
    319       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_evapls04   
    320       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_evapls05   
    321 !$OMP THREADPRIVATE(d_tr_evapls01,d_tr_evapls02,d_tr_evapls03,d_tr_evapls04,d_tr_evapls05)
    322       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_ls01
    323       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_ls02
    324       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_ls03
    325       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_ls04
    326       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_ls05
    327 !$OMP THREADPRIVATE(d_tr_ls01,d_tr_ls02,d_tr_ls03,d_tr_ls04,d_tr_ls05)
    328 
    329       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_dyn01
    330       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_dyn02
    331       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_dyn03
    332       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_dyn04
    333       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_dyn05
    334 !$OMP THREADPRIVATE(d_tr_dyn01,d_tr_dyn02,d_tr_dyn03,d_tr_dyn04,d_tr_dyn05)
    335 
    336       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cl01
    337       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cl02
    338       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cl03
    339       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cl04
    340       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cl05
    341 !$OMP THREADPRIVATE(d_tr_cl01,d_tr_cl02,d_tr_cl03,d_tr_cl04,d_tr_cl05)
    342 
    343       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_th01
    344       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_th02
    345       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_th03
    346       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_th04
    347       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_th05
    348 !$OMP THREADPRIVATE(d_tr_th01,d_tr_th02,d_tr_th03,d_tr_th04,d_tr_th05)
    349 
    350       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: sed_ss3D    ! corresponds to tracer 3
    351       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: sed_dust3D  ! corresponds to tracer 4
    352       REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: sed_dustsco3D  ! corresponds to tracer 4
    353 !$OMP THREADPRIVATE(sed_ss3D,sed_dust3D,sed_dustsco3D)
    354 
    355 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    356 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    357       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sed_ss    ! corresponds to tracer 3
    358       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sed_dust  ! corresponds to tracer 4
    359       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sed_dustsco  ! corresponds to tracer 4
    360       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: his_g2pgas  ! corresponds to tracer 4
    361       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: his_g2paer  ! corresponds to tracer 4
    362 !$OMP THREADPRIVATE(sed_ss,sed_dust,sed_dustsco,his_g2pgas,his_g2paer)
    363 
    364       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbb
    365       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxff
    366       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcbb
    367       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcff
    368       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcnff
    369 !$OMP THREADPRIVATE(fluxbb,fluxff,fluxbcbb,fluxbcff,fluxbcnff)
    370       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcba
    371       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbc
    372       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxombb
    373       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomff
    374       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomnff
    375 !$OMP THREADPRIVATE(fluxbcba,fluxbc,fluxombb,fluxomff,fluxomnff)
    376       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomba
    377       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomnat
    378       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxom
    379       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxh2sff
    380       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxh2snff
    381 !$OMP THREADPRIVATE(fluxomba,fluxomnat,fluxom,fluxh2sff,fluxh2snff)
    382       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2ff
    383       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2nff
    384       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2bb
    385       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2vol
    386       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2ba
    387 !$OMP THREADPRIVATE(fluxso2ff,fluxso2nff,fluxso2bb,fluxso2vol,fluxso2ba)
    388       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2
    389       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4ff
    390       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4nff
    391       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4bb
    392       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4ba
    393 !$OMP THREADPRIVATE(fluxso2,fluxso4ff,fluxso4nff,fluxso4ba,fluxso4bb)
    394       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4
    395       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxdms
    396       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxh2sbio
    397       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxdustec
    398       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxddfine
    399 !$OMP THREADPRIVATE(fluxso4,fluxdms,fluxh2sbio,fluxdustec,fluxddfine)
    400       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxddcoa
    401       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxddsco
    402       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxdd
    403       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxssfine
    404       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxsscoa
    405 !$OMP THREADPRIVATE(fluxddcoa,fluxddsco,fluxdd,fluxssfine,fluxsscoa)
    406       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxss
    407       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ind
    408       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_bb
    409       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ff
    410 !$OMP THREADPRIVATE(fluxss,flux_sparam_ind,flux_sparam_bb,flux_sparam_ff)
    411       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ddfine
    412       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ddcoa
    413       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ddsco
    414       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ssfine
    415 !$OMP THREADPRIVATE(flux_sparam_ddfine,flux_sparam_ddcoa)
    416 !$OMP THREADPRIVATE(flux_sparam_ddsco,flux_sparam_ssfine)
    417       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_sscoa
    418       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: u10m_ss
    419       REAL, DIMENSION(:), ALLOCATABLE, SAVE :: v10m_ss
    420 !$OMP THREADPRIVATE(flux_sparam_sscoa,u10m_ss,v10m_ss)
    421 
    422 ! Select dust emission scheme for the Sahara:
    423 !      LOGICAL,PARAMETER,SAVE ::  ok_chimeredust=.FALSE.
    424       LOGICAL,PARAMETER ::  ok_chimeredust=.TRUE.
    425 !!!!!! !$OMP THREADPRIVATE(ok_chimeredust)
     91  LOGICAL, parameter :: edgar = .true.
     92  INTEGER, parameter :: flag_dms = 4
     93  INTEGER(kind = 4)  nbjour
     94
     95  ! Tracer tendencies, for outputs
     96  !-------------------------------
     97  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_cl  ! Td couche
     98  !. limite/traceur
     99  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_dec
     100  !RomP
     101  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_cv  ! Td
     102  !onvection/traceur
     103  ! RomP >>>
     104  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_insc
     105  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_bcscav
     106  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_evapls
     107  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_ls
     108  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_trsp
     109  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_sscav
     110  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_sat
     111  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_uscav
     112  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: qPr, qDi ! concentration tra
     113  !dans pluie,air descente insaturee
     114  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: qPa, qMel
     115  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: qTrdi, dtrcvMA ! conc traceur
     116  !descente air insaturee et td convective MA
     117  !! RomP <<<
     118  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_th  ! Td thermique
     119  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_lessi_impa ! Td du
     120  !lessivage par impaction
     121  REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_lessi_nucl ! Td du
     122  !lessivage par nucleation
     123  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: qPrls      !jyg:
     124  !oncentration tra dans pluie LS a la surf.
     125  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dry ! Td depot
     126  !sec/traceur (1st layer),ALLOCATABLE,SAVE  jyg
     127  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: flux_tr_dry ! depot
     128  !sec/traceur (surface),ALLOCATABLE,SAVE    jyg
     129
     130  ! Index of each traceur
     131  INTEGER, SAVE :: id_prec, id_fine, id_coss, id_codu, id_scdu
     132
     133  !$OMP THREADPRIVATE(d_tr_cl,d_tr_dec,d_tr_cv,d_tr_insc,d_tr_bcscav,d_tr_evapls)
     134  !$OMP THREADPRIVATE(d_tr_ls,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav)
     135  !$OMP THREADPRIVATE(qPr,qDi,qPa,qMel,qTrdi,dtrcvMA,d_tr_th,d_tr_lessi_impa)
     136  !$OMP THREADPRIVATE(d_tr_lessi_nucl,qPrls,d_tr_dry,flux_tr_dry)
     137  !$OMP THREADPRIVATE(id_prec,id_fine,id_coss,id_codu,id_scdu)
     138
     139  ! JE20141224 <<
     140
     141  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diff_aod550_tot  ! epaisseur optique total aerosol 550  nm
     142  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod670_tot  ! epaisseur optique total aerosol 670 nm
     143  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod865_tot  ! epaisseur optique total aerosol 865 nm
     144  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diff_aod550_tr2  ! epaisseur optique Traceur 2 aerosol 550 nm, diagnostic
     145  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod670_tr2  ! epaisseur optique Traceur 2 aerosol 670 nm, diagnostic
     146  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod865_tr2  ! epaisseur optique Traceur 2 aerosol 865 nm, diagnostic
     147  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod550_ss  ! epaisseur optique Sels marins aerosol 550 nm, diagnostic
     148  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod670_ss  ! epaisseur optique Sels marins aerosol 670 nm, diagnostic
     149  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod865_ss   ! epaisseur optique Sels marins aerosol 865 nm, diagnostic
     150  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod550_dust ! epaisseur optique Dust aerosol 550 nm, diagnostic
     151  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod670_dust ! epaisseur optique Dust aerosol 670 nm, diagnostic
     152  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod865_dust ! epaisseur optique Dust aerosol 865 nm, diagnostic
     153  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod550_dustsco ! epaisseur optique Dust SCOarse aerosol 550 nm, diagnostic
     154  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod670_dustsco ! epaisseur optique Dust SCOarse aerosol 670 nm, diagnostic
     155  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod865_dustsco ! epaisseur optique Dust SCOarse aerosol 865 nm, diagnostic
     156
     157  !$OMP THREADPRIVATE(diff_aod550_tot,diag_aod670_tot,diag_aod865_tot)
     158  !$OMP THREADPRIVATE(diff_aod550_tr2,diag_aod670_tr2,diag_aod865_tr2)
     159  !$OMP THREADPRIVATE(diag_aod550_ss,diag_aod670_ss,diag_aod865_ss,diag_aod550_dust)
     160  !$OMP THREADPRIVATE(diag_aod670_dust,diag_aod865_dust,diag_aod550_dustsco)
     161  !$OMP THREADPRIVATE(diag_aod670_dustsco,diag_aod865_dustsco)
     162
     163  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_terra  ! AOD at terra overpass time ( 10.30 local hour)
     164  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_tr2_terra  ! AOD at terra overpass time ( 10.30 local hour)
     165  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_ss_terra  ! AOD at terra overpass time ( 10.30 local hour)
     166  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dust_terra  ! AOD at terra overpass time ( 10.30 local hour)
     167  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dustsco_terra  ! AOD at terra overpass time ( 10.30 local hour)
     168  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_terra  ! AOD at terra overpass time ( 10.30 local hour)
     169  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_tr2_terra  ! AOD at terra overpass time ( 10.30 local hour)
     170  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_ss_terra  ! AOD at terra overpass time ( 10.30 local hour)
     171  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dust_terra  ! AOD at terra overpass time ( 10.30 local hour)
     172  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dustsco_terra  ! AOD at terra overpass time ( 10.30 local hour)
     173  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_terra  ! AOD at terra overpass time ( 10.30 local hour)
     174  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_tr2_terra  ! AOD at terra overpass time ( 10.30 local hour)
     175  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_ss_terra  ! AOD at terra overpass time ( 10.30 local hour)
     176  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dust_terra  ! AOD at terra overpass time ( 10.30 local hour)
     177  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dustsco_terra  ! AOD at terra overpass time ( 10.30 local hour)
     178
     179  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
     180  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_tr2_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
     181  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_ss_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
     182  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dust_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
     183  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dustsco_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
     184  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
     185  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_tr2_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
     186  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_ss_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
     187  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dust_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
     188  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dustsco_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
     189  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
     190  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_tr2_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
     191  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_ss_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
     192  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dust_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
     193  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dustsco_aqua  ! AOD at aqua overpass time ( 13.30 local hour)
     194
     195  !$OMP THREADPRIVATE(aod550_aqua,aod550_tr2_aqua,aod550_ss_aqua,aod550_dust_aqua,aod550_dustsco_aqua)
     196  !$OMP THREADPRIVATE(aod670_aqua,aod670_tr2_aqua,aod670_ss_aqua,aod670_dust_aqua,aod670_dustsco_aqua)
     197  !$OMP THREADPRIVATE(aod865_aqua,aod865_tr2_aqua,aod865_ss_aqua,aod865_dust_aqua,aod865_dustsco_aqua)
     198  !$OMP THREADPRIVATE(aod550_terra,aod550_tr2_terra,aod550_ss_terra,aod550_dust_terra,aod550_dustsco_terra)
     199  !$OMP THREADPRIVATE(aod670_terra,aod670_tr2_terra,aod670_ss_terra,aod670_dust_terra,aod670_dustsco_terra)
     200  !$OMP THREADPRIVATE(aod865_terra,aod865_tr2_terra,aod865_ss_terra,aod865_dust_terra,aod865_dustsco_terra)
     201
     202  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc01 ! surface concentration
     203  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm01   ! burden
     204  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc02 ! surface concentration
     205  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm02   ! burden
     206  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc03 ! surface concentration
     207  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm03   ! burden
     208  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc04 ! surface concentration
     209  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm04   ! burden
     210  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc05 ! surface concentration
     211  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm05   ! burden
     212  !$OMP THREADPRIVATE(sconc01,sconc02,sconc03,sconc04,sconc05)
     213  !$OMP THREADPRIVATE(trm01,trm02,trm03,trm04,trm05)
     214  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux01
     215  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux02
     216  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux03
     217  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux04
     218  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux05
     219  !$OMP THREADPRIVATE(flux01,flux02,flux03,flux04,flux05)
     220  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds01
     221  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds02
     222  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds03
     223  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds04
     224  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds05
     225  !$OMP THREADPRIVATE(ds01,ds02,ds03,ds04,ds05)
     226  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh01
     227  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh02
     228  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh03
     229  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh04
     230  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh05
     231  !$OMP THREADPRIVATE(dh01,dh02,dh03,dh04,dh05)
     232  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv01
     233  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv02
     234  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv03
     235  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv04
     236  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv05
     237  !$OMP THREADPRIVATE(dtrconv01,dtrconv02,dtrconv03,dtrconv04,dtrconv05)
     238  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm01
     239  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm02
     240  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm03
     241  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm04
     242  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm05
     243  !$OMP THREADPRIVATE(dtherm01,dtherm02,dtherm03,dtherm04,dtherm05)
     244  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv01
     245  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv02
     246  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv03
     247  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv04
     248  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv05
     249  !$OMP THREADPRIVATE(dhkecv01,dhkecv02,dhkecv03,dhkecv04,dhkecv05)
     250  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds01
     251  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds02
     252  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds03
     253  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds04
     254  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds05
     255  !$OMP THREADPRIVATE(d_tr_ds01,d_tr_ds02,d_tr_ds03,d_tr_ds04,d_tr_ds05)
     256  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc01
     257  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc02
     258  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc03
     259  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc04
     260  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc05
     261  !$OMP THREADPRIVATE(dhkelsc01,dhkelsc02,dhkelsc03,dhkelsc04,dhkelsc05)
     262  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cv01
     263  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cv02
     264  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cv03
     265  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cv04
     266  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cv05
     267  !$OMP THREADPRIVATE(d_tr_cv01,d_tr_cv02,d_tr_cv03,d_tr_cv04,d_tr_cv05)
     268  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_trsp01
     269  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_trsp02
     270  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_trsp03
     271  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_trsp04
     272  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_trsp05
     273  !$OMP THREADPRIVATE(d_tr_trsp01,d_tr_trsp02,d_tr_trsp03,d_tr_trsp04,d_tr_trsp05)
     274  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sscav01
     275  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sscav02
     276  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sscav03
     277  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sscav04
     278  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sscav05
     279  !$OMP THREADPRIVATE(d_tr_sscav01,d_tr_sscav02,d_tr_sscav03,d_tr_sscav04,d_tr_sscav05)
     280  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sat01
     281  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sat02
     282  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sat03
     283  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sat04
     284  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sat05
     285  !$OMP THREADPRIVATE(d_tr_sat01,d_tr_sat02,d_tr_sat03,d_tr_sat04,d_tr_sat05)
     286  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_uscav01
     287  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_uscav02
     288  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_uscav03
     289  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_uscav04
     290  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_uscav05
     291  !$OMP THREADPRIVATE(d_tr_uscav01,d_tr_uscav02,d_tr_uscav03,d_tr_uscav04,d_tr_uscav05)
     292
     293  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     294  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     295  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     296
     297  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_insc01
     298  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_insc02
     299  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_insc03
     300  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_insc04
     301  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_insc05
     302  !$OMP THREADPRIVATE(d_tr_insc01,d_tr_insc02,d_tr_insc03,d_tr_insc04,d_tr_insc05)
     303  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_bcscav01
     304  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_bcscav02
     305  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_bcscav03
     306  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_bcscav04
     307  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_bcscav05
     308  !$OMP THREADPRIVATE(d_tr_bcscav01,d_tr_bcscav02,d_tr_bcscav03,d_tr_bcscav04,d_tr_bcscav05)
     309  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_evapls01
     310  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_evapls02
     311  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_evapls03
     312  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_evapls04
     313  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_evapls05
     314  !$OMP THREADPRIVATE(d_tr_evapls01,d_tr_evapls02,d_tr_evapls03,d_tr_evapls04,d_tr_evapls05)
     315  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_ls01
     316  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_ls02
     317  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_ls03
     318  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_ls04
     319  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_ls05
     320  !$OMP THREADPRIVATE(d_tr_ls01,d_tr_ls02,d_tr_ls03,d_tr_ls04,d_tr_ls05)
     321
     322  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dyn01
     323  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dyn02
     324  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dyn03
     325  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dyn04
     326  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dyn05
     327  !$OMP THREADPRIVATE(d_tr_dyn01,d_tr_dyn02,d_tr_dyn03,d_tr_dyn04,d_tr_dyn05)
     328
     329  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cl01
     330  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cl02
     331  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cl03
     332  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cl04
     333  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cl05
     334  !$OMP THREADPRIVATE(d_tr_cl01,d_tr_cl02,d_tr_cl03,d_tr_cl04,d_tr_cl05)
     335
     336  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_th01
     337  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_th02
     338  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_th03
     339  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_th04
     340  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_th05
     341  !$OMP THREADPRIVATE(d_tr_th01,d_tr_th02,d_tr_th03,d_tr_th04,d_tr_th05)
     342
     343  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: sed_ss3D    ! corresponds to tracer 3
     344  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: sed_dust3D  ! corresponds to tracer 4
     345  REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: sed_dustsco3D  ! corresponds to tracer 4
     346  !$OMP THREADPRIVATE(sed_ss3D,sed_dust3D,sed_dustsco3D)
     347
     348  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     349  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     350  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sed_ss    ! corresponds to tracer 3
     351  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sed_dust  ! corresponds to tracer 4
     352  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sed_dustsco  ! corresponds to tracer 4
     353  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: his_g2pgas  ! corresponds to tracer 4
     354  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: his_g2paer  ! corresponds to tracer 4
     355  !$OMP THREADPRIVATE(sed_ss,sed_dust,sed_dustsco,his_g2pgas,his_g2paer)
     356
     357  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbb
     358  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxff
     359  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcbb
     360  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcff
     361  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcnff
     362  !$OMP THREADPRIVATE(fluxbb,fluxff,fluxbcbb,fluxbcff,fluxbcnff)
     363  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcba
     364  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbc
     365  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxombb
     366  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomff
     367  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomnff
     368  !$OMP THREADPRIVATE(fluxbcba,fluxbc,fluxombb,fluxomff,fluxomnff)
     369  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomba
     370  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomnat
     371  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxom
     372  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxh2sff
     373  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxh2snff
     374  !$OMP THREADPRIVATE(fluxomba,fluxomnat,fluxom,fluxh2sff,fluxh2snff)
     375  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2ff
     376  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2nff
     377  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2bb
     378  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2vol
     379  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2ba
     380  !$OMP THREADPRIVATE(fluxso2ff,fluxso2nff,fluxso2bb,fluxso2vol,fluxso2ba)
     381  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2
     382  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4ff
     383  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4nff
     384  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4bb
     385  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4ba
     386  !$OMP THREADPRIVATE(fluxso2,fluxso4ff,fluxso4nff,fluxso4ba,fluxso4bb)
     387  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4
     388  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxdms
     389  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxh2sbio
     390  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxdustec
     391  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxddfine
     392  !$OMP THREADPRIVATE(fluxso4,fluxdms,fluxh2sbio,fluxdustec,fluxddfine)
     393  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxddcoa
     394  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxddsco
     395  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxdd
     396  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxssfine
     397  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxsscoa
     398  !$OMP THREADPRIVATE(fluxddcoa,fluxddsco,fluxdd,fluxssfine,fluxsscoa)
     399  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxss
     400  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ind
     401  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_bb
     402  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ff
     403  !$OMP THREADPRIVATE(fluxss,flux_sparam_ind,flux_sparam_bb,flux_sparam_ff)
     404  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ddfine
     405  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ddcoa
     406  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ddsco
     407  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ssfine
     408  !$OMP THREADPRIVATE(flux_sparam_ddfine,flux_sparam_ddcoa)
     409  !$OMP THREADPRIVATE(flux_sparam_ddsco,flux_sparam_ssfine)
     410  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_sscoa
     411  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: u10m_ss
     412  REAL, DIMENSION(:), ALLOCATABLE, SAVE :: v10m_ss
     413  !$OMP THREADPRIVATE(flux_sparam_sscoa,u10m_ss,v10m_ss)
     414
     415  ! Select dust emission scheme for the Sahara:
     416  !      LOGICAL,PARAMETER,SAVE ::  ok_chimeredust=.FALSE.
     417  LOGICAL, PARAMETER :: ok_chimeredust = .TRUE.
     418  !!!!!! !$OMP THREADPRIVATE(ok_chimeredust)
    426419
    427420
    428421CONTAINS
    429 !
    430 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    431 SUBROUTINE phytracr_spl_out_init()
    432 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    433 !AS : This subroutine centralises the ALLOCATE needed for the 1st call of
    434 !     phys_output_write_spl in physiq
     422
     423  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     424  SUBROUTINE phytracr_spl_out_init()
     425    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     426    !AS : This subroutine centralises the ALLOCATE needed for the 1st call of
     427    !     phys_output_write_spl in physiq
    435428
    436429    USE dimphy
    437     USE infotrac_phy, ONLY: nbtr
    438     USE dustemission_mod, ONLY :  dustemis_out_init
     430    USE infotrac_phy, ONLY : nbtr
     431    USE dustemission_mod, ONLY : dustemis_out_init
    439432
    440433    ! pour les variables m[1-3]dflux
    441     CALL dustemis_out_init()
    442 
    443 !traceur
    444       ALLOCATE( diff_aod550_tot(klon)     )
    445       ALLOCATE( diag_aod670_tot(klon)     )
    446       ALLOCATE( diag_aod865_tot(klon)     )
    447       ALLOCATE( diff_aod550_tr2(klon)     )
    448       ALLOCATE( diag_aod670_tr2(klon)     )
    449       ALLOCATE( diag_aod865_tr2(klon)     )
    450       ALLOCATE( diag_aod550_ss(klon)      )
    451       ALLOCATE( diag_aod670_ss(klon)      )
    452       ALLOCATE( diag_aod865_ss(klon)      )
    453       ALLOCATE( diag_aod550_dust(klon)    )
    454       ALLOCATE( diag_aod670_dust(klon)    )
    455       ALLOCATE( diag_aod865_dust(klon)    )
    456       ALLOCATE( diag_aod550_dustsco(klon)  )
    457       ALLOCATE( diag_aod670_dustsco(klon)  )
    458       ALLOCATE( diag_aod865_dustsco(klon)  )
    459       !AS: les 15 vars _terra et 15 _aqua suivantes sont groupees differemment dans spla_output_write.h
    460       ALLOCATE( aod550_terra(klon))
    461       ALLOCATE( aod550_tr2_terra(klon))
    462       ALLOCATE( aod550_ss_terra(klon))
    463       ALLOCATE( aod550_dust_terra(klon))
    464       ALLOCATE( aod550_dustsco_terra(klon))
    465       ALLOCATE( aod670_terra(klon))
    466       ALLOCATE( aod670_tr2_terra(klon))
    467       ALLOCATE( aod670_ss_terra(klon))
    468       ALLOCATE( aod670_dust_terra(klon))
    469       ALLOCATE( aod670_dustsco_terra(klon))
    470       ALLOCATE( aod865_terra(klon))
    471       ALLOCATE( aod865_tr2_terra(klon))
    472       ALLOCATE( aod865_ss_terra(klon))
    473       ALLOCATE( aod865_dust_terra(klon))
    474       ALLOCATE( aod865_dustsco_terra(klon))
    475 
    476       ALLOCATE( aod550_aqua(klon))
    477       ALLOCATE( aod550_tr2_aqua(klon))
    478       ALLOCATE( aod550_ss_aqua(klon))
    479       ALLOCATE( aod550_dust_aqua(klon))
    480       ALLOCATE( aod550_dustsco_aqua(klon))
    481       ALLOCATE( aod670_aqua(klon))
    482       ALLOCATE( aod670_tr2_aqua(klon))
    483       ALLOCATE( aod670_ss_aqua(klon))
    484       ALLOCATE( aod670_dust_aqua(klon))
    485       ALLOCATE( aod670_dustsco_aqua(klon))
    486       ALLOCATE( aod865_aqua(klon))
    487       ALLOCATE( aod865_tr2_aqua(klon))
    488       ALLOCATE( aod865_ss_aqua(klon))
    489       ALLOCATE( aod865_dust_aqua(klon))
    490       ALLOCATE( aod865_dustsco_aqua(klon))
    491 
    492       ALLOCATE(  sconc01(klon)     )
    493       ALLOCATE(  trm01(klon)     )
    494       ALLOCATE(  sconc02(klon)     )
    495       ALLOCATE(  trm02(klon)     )
    496       ALLOCATE(  sconc03(klon)     )
    497       ALLOCATE(  trm03(klon)     )
    498       ALLOCATE(  sconc04(klon)     )
    499       ALLOCATE(  trm04(klon)     )
    500       ALLOCATE(  sconc05(klon)     )
    501       ALLOCATE(  trm05(klon)     )
    502 
    503 ! Lessivage
    504       ALLOCATE(  flux01(klon)     )
    505       ALLOCATE(  flux02(klon)     )
    506       ALLOCATE(  flux03(klon)     )
    507       ALLOCATE(  flux04(klon)     )
    508       ALLOCATE(  flux05(klon)     )
    509       ALLOCATE(  ds01(klon)     )
    510       ALLOCATE(  ds02(klon)     )
    511       ALLOCATE(  ds03(klon)     )
    512       ALLOCATE(  ds04(klon)     )
    513       ALLOCATE(  ds05(klon)     )
    514       ALLOCATE(  dh01(klon)     )
    515       ALLOCATE(  dh02(klon)     )
    516       ALLOCATE(  dh03(klon)     )
    517       ALLOCATE(  dh04(klon)     )
    518       ALLOCATE(  dh05(klon)     )
    519       ALLOCATE(  dtrconv01(klon)     )
    520       ALLOCATE(  dtrconv02(klon)     )
    521       ALLOCATE(  dtrconv03(klon)     )
    522       ALLOCATE(  dtrconv04(klon)     )
    523       ALLOCATE(  dtrconv05(klon)     )
    524       ALLOCATE(  dtherm01(klon)     )
    525       ALLOCATE(  dtherm02(klon)     )
    526       ALLOCATE(  dtherm03(klon)     )
    527       ALLOCATE(  dtherm04(klon)     )
    528       ALLOCATE(  dtherm05(klon)     )
    529       ALLOCATE(  dhkecv01(klon)     )
    530       ALLOCATE(  dhkecv02(klon)     )
    531       ALLOCATE(  dhkecv03(klon)     )
    532       ALLOCATE(  dhkecv04(klon)     )
    533       ALLOCATE(  dhkecv05(klon)     )
    534       ALLOCATE(  d_tr_ds01(klon)     )
    535       ALLOCATE(  d_tr_ds02(klon)     )
    536       ALLOCATE(  d_tr_ds03(klon)     )
    537       ALLOCATE(  d_tr_ds04(klon)     )
    538       ALLOCATE(  d_tr_ds05(klon)     )
    539       ALLOCATE(  dhkelsc01(klon)     )
    540       ALLOCATE(  dhkelsc02(klon)     )
    541       ALLOCATE(  dhkelsc03(klon)     )
    542       ALLOCATE(  dhkelsc04(klon)     )
    543       ALLOCATE(  dhkelsc05(klon)     )
    544       ALLOCATE(  d_tr_cv01(klon,klev))
    545       ALLOCATE(  d_tr_cv02(klon,klev))
    546       ALLOCATE(  d_tr_cv03(klon,klev))
    547       ALLOCATE(  d_tr_cv04(klon,klev))
    548       ALLOCATE(  d_tr_cv05(klon,klev))
    549       ALLOCATE(  d_tr_trsp01(klon,klev))
    550       ALLOCATE(  d_tr_trsp02(klon,klev))
    551       ALLOCATE(  d_tr_trsp03(klon,klev))
    552       ALLOCATE(  d_tr_trsp04(klon,klev))
    553       ALLOCATE(  d_tr_trsp05(klon,klev))
    554       ALLOCATE(  d_tr_sscav01(klon,klev))
    555       ALLOCATE(  d_tr_sscav02(klon,klev))
    556       ALLOCATE(  d_tr_sscav03(klon,klev))
    557       ALLOCATE(  d_tr_sscav04(klon,klev))
    558       ALLOCATE(  d_tr_sscav05(klon,klev))
    559       ALLOCATE(  d_tr_sat01(klon,klev))
    560       ALLOCATE(  d_tr_sat02(klon,klev))
    561       ALLOCATE(  d_tr_sat03(klon,klev))
    562       ALLOCATE(  d_tr_sat04(klon,klev))
    563       ALLOCATE(  d_tr_sat05(klon,klev))
    564       ALLOCATE(  d_tr_uscav01(klon,klev))
    565       ALLOCATE(  d_tr_uscav02(klon,klev))
    566       ALLOCATE(  d_tr_uscav03(klon,klev))
    567       ALLOCATE(  d_tr_uscav04(klon,klev))
    568       ALLOCATE(  d_tr_uscav05(klon,klev))
    569 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    570       ALLOCATE(  d_tr_insc01(klon,klev))
    571       ALLOCATE(  d_tr_insc02(klon,klev))
    572       ALLOCATE(  d_tr_insc03(klon,klev))
    573       ALLOCATE(  d_tr_insc04(klon,klev))
    574       ALLOCATE(  d_tr_insc05(klon,klev))
    575       ALLOCATE(  d_tr_bcscav01(klon,klev))
    576       ALLOCATE(  d_tr_bcscav02(klon,klev))
    577       ALLOCATE(  d_tr_bcscav03(klon,klev))
    578       ALLOCATE(  d_tr_bcscav04(klon,klev))
    579       ALLOCATE(  d_tr_bcscav05(klon,klev))
    580       ALLOCATE(  d_tr_evapls01(klon,klev))
    581       ALLOCATE(  d_tr_evapls02(klon,klev))
    582       ALLOCATE(  d_tr_evapls03(klon,klev))
    583       ALLOCATE(  d_tr_evapls04(klon,klev))
    584       ALLOCATE(  d_tr_evapls05(klon,klev))
    585       ALLOCATE(  d_tr_ls01(klon,klev))
    586       ALLOCATE(  d_tr_ls02(klon,klev))
    587       ALLOCATE(  d_tr_ls03(klon,klev))
    588       ALLOCATE(  d_tr_ls04(klon,klev))
    589       ALLOCATE(  d_tr_ls05(klon,klev))
    590 
    591       ALLOCATE(  d_tr_dyn01(klon,klev))
    592       ALLOCATE(  d_tr_dyn02(klon,klev))
    593       ALLOCATE(  d_tr_dyn03(klon,klev))
    594       ALLOCATE(  d_tr_dyn04(klon,klev))
    595       ALLOCATE(  d_tr_dyn05(klon,klev))
    596 
    597       ALLOCATE(  d_tr_cl01(klon,klev))
    598       ALLOCATE(  d_tr_cl02(klon,klev))
    599       ALLOCATE(  d_tr_cl03(klon,klev))
    600       ALLOCATE(  d_tr_cl04(klon,klev))
    601       ALLOCATE(  d_tr_cl05(klon,klev))
    602       ALLOCATE(  d_tr_th01(klon,klev))
    603       ALLOCATE(  d_tr_th02(klon,klev))
    604       ALLOCATE(  d_tr_th03(klon,klev))
    605       ALLOCATE(  d_tr_th04(klon,klev))
    606       ALLOCATE(  d_tr_th05(klon,klev))
    607 
    608       ALLOCATE( sed_ss(klon))
    609       ALLOCATE( sed_dust(klon))
    610       ALLOCATE( sed_dustsco(klon))
    611       ALLOCATE( his_g2pgas(klon))
    612       ALLOCATE( his_g2paer(klon))
    613 
    614 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    615       ALLOCATE( sed_ss3D(klon,klev))
    616       ALLOCATE( sed_dust3D(klon,klev))
    617       ALLOCATE( sed_dustsco3D(klon,klev))
    618 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    619 
    620 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    621 ! histrac_spl
    622 !
    623       ALLOCATE( fluxbb(klon))
    624       ALLOCATE( fluxff(klon))
    625       ALLOCATE( fluxbcbb(klon))
    626       ALLOCATE( fluxbcff(klon))
    627       ALLOCATE( fluxbcnff(klon))
    628       ALLOCATE( fluxbcba(klon))
    629       ALLOCATE( fluxbc(klon))
    630       ALLOCATE( fluxombb(klon))
    631       ALLOCATE( fluxomff(klon))
    632       ALLOCATE( fluxomnff(klon))
    633       ALLOCATE( fluxomba(klon))
    634       ALLOCATE( fluxomnat(klon))
    635       ALLOCATE( fluxom(klon))
    636       ALLOCATE( fluxh2sff(klon))
    637       ALLOCATE( fluxh2snff(klon))
    638       ALLOCATE( fluxso2ff(klon))
    639       ALLOCATE( fluxso2nff(klon))
    640       ALLOCATE( fluxso2bb(klon))
    641       ALLOCATE( fluxso2vol(klon))
    642       ALLOCATE( fluxso2ba(klon))
    643       ALLOCATE( fluxso2(klon))
    644       ALLOCATE( fluxso4ff(klon))
    645       ALLOCATE( fluxso4nff(klon))
    646       ALLOCATE( fluxso4bb(klon))
    647       ALLOCATE( fluxso4ba(klon))
    648       ALLOCATE( fluxso4(klon))
    649       ALLOCATE( fluxdms(klon))
    650       ALLOCATE( fluxh2sbio(klon))
    651       ALLOCATE( fluxdustec(klon))
    652       ALLOCATE( fluxddfine(klon))
    653       ALLOCATE( fluxddcoa(klon))
    654       ALLOCATE( fluxddsco(klon))
    655       ALLOCATE( fluxdd(klon))
    656       ALLOCATE( fluxssfine(klon))
    657       ALLOCATE( fluxsscoa(klon))
    658       ALLOCATE( fluxss(klon))
    659       ALLOCATE( flux_sparam_ind(klon))
    660       ALLOCATE( flux_sparam_bb(klon))
    661       ALLOCATE( flux_sparam_ff(klon))
    662       ALLOCATE( flux_sparam_ddfine(klon))
    663       ALLOCATE( flux_sparam_ddcoa(klon))
    664       ALLOCATE( flux_sparam_ddsco(klon))
    665       ALLOCATE( flux_sparam_ssfine(klon))
    666       ALLOCATE( flux_sparam_sscoa(klon))
    667       ALLOCATE( u10m_ss(klon))
    668       ALLOCATE( v10m_ss(klon))
    669 
    670 !AS: in phys_output_write_spl, but not in spla_output_write.h
    671 !------------------------------------------------------
    672       ALLOCATE(d_tr_cl(klon,klev,nbtr))
    673       ALLOCATE(d_tr_th(klon,klev,nbtr))
    674       ALLOCATE(d_tr_cv(klon,klev,nbtr))
    675       ALLOCATE(d_tr_lessi_impa(klon,klev,nbtr))
    676       ALLOCATE(d_tr_lessi_nucl(klon,klev,nbtr))
    677       ALLOCATE(d_tr_insc(klon,klev,nbtr))
    678       ALLOCATE(d_tr_bcscav(klon,klev,nbtr))
    679       ALLOCATE(d_tr_evapls(klon,klev,nbtr))
    680       ALLOCATE(d_tr_ls(klon,klev,nbtr))
    681       ALLOCATE(d_tr_trsp(klon,klev,nbtr))
    682       ALLOCATE(d_tr_sscav(klon,klev,nbtr))
    683       ALLOCATE(d_tr_sat(klon,klev,nbtr))
    684       ALLOCATE(d_tr_uscav(klon,klev,nbtr))
    685      
    686 END SUBROUTINE phytracr_spl_out_init
    687 
    688 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    689 SUBROUTINE phytracr_spl_ini(klon,nbreg_ind,nbreg_bb,nbreg_dust,nbreg_wstardust)
    690 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    691 
    692 
    693   IMPLICIT NONE
    694   INTEGER klon,nbreg_ind,nbreg_bb,nbreg_dust,nbreg_wstardust
    695 
    696   ALLOCATE(  tsol(klon)              )
    697 
    698 !AS: IF permettant le debranchage des coefs de Jeronimo Escribano: fichiers *_meta
    699 ! nbreg_* sont initialisés à 1 dans phytracr_spl, if debutphy,
    700 ! avant d'appeler la subroutine presente, phytracr_spl_ini
    701 ! (phytracr_spl_ini appele readregionsdims2_spl,
    702 ! qui lit et fait "bcast" de nbreg_ind,_bb,_dust,_wstardust dans fichiers regions_*_meta)
    703 IF("ASSIM"=="YES") THEN
    704   fileregionsdimsind='regions_ind_meta'
    705   fileregionsdimsdust='regions_dustacc_meta'
    706 !  fileregionsdimsdust='regions_dust_meta'
    707   fileregionsdimsbb='regions_bb_meta'
    708   fileregionsdimswstar='regions_pwstarwake_meta'
    709   call  readregionsdims2_spl(nbreg_ind,fileregionsdimsind)
    710   call  readregionsdims2_spl(nbreg_dust,fileregionsdimsdust)
    711   call  readregionsdims2_spl(nbreg_bb,fileregionsdimsbb)
    712   call  readregionsdims2_spl(nbreg_wstardust,fileregionsdimswstar)
    713   ENDIF ! ASSIM
    714 ! fin debranchage
    715 
    716 !readregions_spl()
    717 
    718   ALLOCATE(scale_param_ind(nbreg_ind))
    719   ALLOCATE(scale_param_bb(nbreg_bb))
    720   ALLOCATE(scale_param_ff(nbreg_ind))
    721   ALLOCATE(scale_param_dustacc(nbreg_dust))
    722   ALLOCATE(scale_param_dustcoa(nbreg_dust))
    723   ALLOCATE(scale_param_dustsco(nbreg_dust))
    724   ALLOCATE(param_wstarBLperregion(nbreg_wstardust))
    725   ALLOCATE(param_wstarWAKEperregion(nbreg_wstardust))
    726   ALLOCATE(  dust_ec(klon)           )
    727   ALLOCATE(  u10m_ec(klon)           )
    728   ALLOCATE(  v10m_ec(klon)           )
    729   ALLOCATE(  lmt_so2volc_cont(klon)  )
    730   ALLOCATE(  lmt_altvolc_cont(klon)  )
    731   ALLOCATE(  lmt_so2volc_expl(klon)  )
    732   ALLOCATE(  lmt_altvolc_expl(klon)  )
    733   ALLOCATE(  lmt_so2ff_l(klon)       )   
    734   ALLOCATE(  lmt_so2ff_h(klon)       ) 
    735   ALLOCATE(  lmt_so2nff(klon)        ) 
    736   ALLOCATE(  lmt_so2ba(klon)         ) 
    737   ALLOCATE(  lmt_so2bb_l(klon)       )
    738   ALLOCATE(  lmt_so2bb_h(klon)       ) 
    739   ALLOCATE(  lmt_dmsconc(klon)       ) 
    740   ALLOCATE(  lmt_dmsbio(klon)        ) 
    741   ALLOCATE(  lmt_h2sbio(klon)        ) 
    742   ALLOCATE(  lmt_bcff(klon)          )
    743   ALLOCATE(  lmt_bcnff(klon)         )
    744   ALLOCATE(  lmt_bcbb_l(klon)        )
    745   ALLOCATE(  lmt_bcbb_h(klon)        )
    746   ALLOCATE(  lmt_bcba(klon)          )
    747   ALLOCATE(  lmt_omff(klon)          ) 
    748   ALLOCATE(  lmt_omnff(klon)         ) 
    749   ALLOCATE(  lmt_ombb_l(klon)        ) 
    750   ALLOCATE(  lmt_ombb_h(klon)        ) 
    751   ALLOCATE(  lmt_omnat(klon)         ) 
    752   ALLOCATE(  lmt_omba(klon)          )           
    753   ALLOCATE(lmt_sea_salt(klon,ss_bins))
    754 
    755 
    756 
    757 
    758   !temporal hardcoded null inicialization of assimilation emmision factors
    759 !AS: scale_param sont ensuite lus dans modvalues.nc
    760 ! par la subroutine read_scalenc, appelee par readscaleparamsnc_spl
    761   scale_param_ssacc=1.
    762   scale_param_sscoa=1.
    763   scale_param_ind(:)=1.
    764   scale_param_bb(:)=1.
    765   scale_param_ff(:)=1.
    766   scale_param_dustacc(:)=1.
    767   scale_param_dustcoa(:)=1.
    768   scale_param_dustsco(:)=1.
    769   param_wstarBLperregion(:)=0.
    770   param_wstarWAKEperregion(:)=0.
    771 
    772 
    773 RETURN
    774 END SUBROUTINE phytracr_spl_ini
    775 
    776 
    777 
    778 
    779 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    780       SUBROUTINE phytracr_spl ( debutphy,lafin,jD_cur,jH_cur,iflag_conv, &  ! I
    781                       pdtphys,ftsol,                                   &  ! I
    782                       t_seri,q_seri,paprs,pplay,RHcl,                  &  ! I
    783                       pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,          &  ! I
    784                       coefh, cdragh, cdragm, yu1, yv1,                 &  ! I
    785                       u_seri, v_seri, rlat,rlon,                       &  ! I
    786                       pphis,pctsrf,pmflxr,pmflxs,prfl,psfl,            &  ! I
    787                       da,phi,phi2,d1a,dam,mp,ep,sigd,sij,clw,elij,     &  ! I
    788                       epmlmMm,eplaMm,upwd,dnwd,itop_con,ibas_con,      &  ! I
    789                       evapls,wdtrainA,  wdtrainM,wght_cvfd,              &  ! I
    790                       fm_therm, entr_therm, rneb,                      &  ! I
    791                       beta_fisrt,beta_v1,                              &  ! I
    792                       zu10m,zv10m,wstar,ale_bl,ale_wake,               &  ! I
    793                       d_tr_dyn,tr_seri)                                            ! O
    794 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    795 
    796       USE mod_grid_phy_lmdz
    797       USE mod_phys_lmdz_para
    798       USE IOIPSL
    799       USE dimphy
    800       USE infotrac
    801       USE indice_sol_mod
    802       USE write_field_phy
    803      
    804 
    805       USE mod_phys_lmdz_transfert_para
    806       USE lmdz_thermcell_dq,  ONLY : thermcell_dq
    807       USE phys_cal_mod, only: jD_1jan,year_len, mth_len, days_elapsed, jh_1jan, year_cur, &
    808                               mth_cur, phys_cal_update
    809 
    810 !
    811       IMPLICIT none
    812 !
    813 
    814 !======================================================================
    815 ! Auteur(s) FH
    816 ! Objet: Moniteur general des tendances traceurs
    817 !
    818 ! Remarques en vrac:
    819 ! ------------------
    820 ! 1/ le call phytrac se fait avec nqmax-2 donc nous avons bien
    821 ! les vrais traceurs (nbtr) dans phytrac (pas la vapeur ni eau liquide)
    822 !! AS : nqmax-2 devrait etre nqmax-3 apres introducton de H2Oi ;
    823 !!   et c'est encore different avec le parser de DC ?
    824 !======================================================================
    825       INCLUDE "dimensions.h"
    826       INCLUDE "chem.h"
    827       INCLUDE "chem_spla.h"
    828       INCLUDE "YOMCST.h"
    829       INCLUDE "YOETHF.h"
    830       INCLUDE "paramet.h"
    831       INCLUDE "alpale.h"
    832 
    833 !======================================================================
    834 
    835 ! Arguments:
    836 !
    837 !  EN ENTREE:
    838 !  ==========
    839 !
    840 !  divers:
    841 !  -------
    842 !
    843       real,intent(in) :: pdtphys  ! pas d'integration pour la physique (seconde)
    844       REAL, intent(in):: jD_cur, jH_cur
    845       real, intent(in) ::  ftsol(klon,nbsrf)  ! temperature du sol par type
    846       real, intent(in) ::  t_seri(klon,klev)  ! temperature
    847       real, intent(in) ::  u_seri(klon,klev)  ! vent
    848       real , intent(in) :: v_seri(klon,klev)  ! vent
    849       real , intent(in) :: q_seri(klon,klev)  ! vapeur d eau kg/kg
    850 
    851 LOGICAL,  INTENT(IN)                          :: lafin
    852 
    853       real tr_seri(klon,klev,nbtr) ! traceur 
    854       real tmp_var(klon,klev) ! auxiliary variable to replace traceur 
    855       real tmp_var2(klon,nbtr) ! auxiliary variable to replace source
    856       real tmp_var3(klon,klev,nbtr) ! auxiliary variable 3D 
    857       real dummy1d ! JE auxiliary variable
    858       real aux_var2(klon) ! auxiliary variable to replace traceur 
    859       real aux_var3(klon,klev) ! auxiliary variable to replace traceur 
    860       real d_tr(klon,klev,nbtr)    ! traceur  tendance
    861       real sconc_seri(klon,nbtr) ! surface concentration of traceur 
    862 !
    863       integer nbjour
    864       save nbjour
    865 !$OMP THREADPRIVATE(nbjour)
    866 !
    867       INTEGER  masque_aqua_cur(klon)
    868       INTEGER  masque_terra_cur(klon)
    869       INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: masque_aqua  !mask for 1 day
    870       INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: masque_terra !
    871 !$OMP THREADPRIVATE(masque_aqua,masque_terra)
    872 
    873   INTEGER, SAVE :: nbreg_dust, nbreg_ind, nbreg_bb, nbreg_ss,nbreg_wstardust
    874   !$OMP THREADPRIVATE(nbreg_dust, nbreg_ind, nbreg_bb,nbreg_ss,nbreg_wstardust)
    875 
    876 
    877 
    878       REAL lmt_dms(klon)           ! emissions de dms
    879 
    880 !JE20150518<<
    881       REAL, DIMENSION(klon_glo)  :: aod550_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
    882       REAL, DIMENSION(klon_glo)  :: aod550_tr2_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
    883       REAL, DIMENSION(klon_glo)  :: aod550_ss_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
    884       REAL, DIMENSION(klon_glo)  :: aod550_dust_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
    885       REAL, DIMENSION(klon_glo)  :: aod550_dustsco_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
    886       REAL, DIMENSION(klon_glo)  :: aod670_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
    887       REAL, DIMENSION(klon_glo)  :: aod670_tr2_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
    888       REAL, DIMENSION(klon_glo)  :: aod670_ss_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
    889       REAL, DIMENSION(klon_glo)  :: aod670_dust_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
    890       REAL, DIMENSION(klon_glo)  :: aod670_dustsco_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
    891       REAL, DIMENSION(klon_glo)  :: aod865_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
    892       REAL, DIMENSION(klon_glo)  :: aod865_tr2_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
    893       REAL, DIMENSION(klon_glo)  :: aod865_ss_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
    894       REAL, DIMENSION(klon_glo)  :: aod865_dust_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
    895       REAL, DIMENSION(klon_glo)  :: aod865_dustsco_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
    896 
    897       REAL, DIMENSION(klon_glo)  :: aod550_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
    898       REAL, DIMENSION(klon_glo)  :: aod550_tr2_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
    899       REAL, DIMENSION(klon_glo)  :: aod550_ss_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
    900       REAL, DIMENSION(klon_glo)  :: aod550_dust_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
    901       REAL, DIMENSION(klon_glo)  :: aod550_dustsco_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
    902       REAL, DIMENSION(klon_glo)  :: aod670_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
    903       REAL, DIMENSION(klon_glo)  :: aod670_tr2_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
    904       REAL, DIMENSION(klon_glo)  :: aod670_ss_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
    905       REAL, DIMENSION(klon_glo)  :: aod670_dust_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
    906       REAL, DIMENSION(klon_glo)  :: aod670_dustsco_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
    907       REAL, DIMENSION(klon_glo)  :: aod865_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
    908       REAL, DIMENSION(klon_glo)  :: aod865_tr2_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
    909       REAL, DIMENSION(klon_glo)  :: aod865_ss_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
    910       REAL, DIMENSION(klon_glo)  :: aod865_dust_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
    911       REAL, DIMENSION(klon_glo)  :: aod865_dustsco_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
    912 !!!!!!!!!!!!!
    913 !JE20150518>>
    914 
    915 
    916 
    917 
    918       real , intent(in) :: paprs(klon,klev+1)  ! pression pour chaque inter-couche (en Pa)
    919       real , intent(in) :: pplay(klon,klev)  ! pression pour le mileu de chaque couche (en Pa)
    920       real , intent(in) :: RHcl(klon,klev)  ! humidite relativen ciel clair
    921       real znivsig(klev)  ! indice des couches
    922       real paire(klon)
    923       real, intent(in) ::  pphis(klon)
    924       real, intent(in) ::  pctsrf(klon,nbsrf)
    925       logical , intent(in) :: debutphy   ! le flag de l'initialisation de la physique
    926 !
    927 !  Scaling Parameters:
    928 !  ----------------------
    929 !
    930       CHARACTER*50 c_Directory
    931       CHARACTER*80 c_FileName1
    932       CHARACTER*80 c_FileName2
    933       CHARACTER*130 c_FullName1
    934       CHARACTER*130 c_FullName2
    935       INTEGER :: xidx, yidx
    936       INTEGER,DIMENSION(klon) :: mask_bbreg
    937       INTEGER,DIMENSION(klon) :: mask_ffso2reg
    938       INTEGER :: aux_mask1
    939       INTEGER :: aux_mask2
    940       INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_so4 !Defines regions for SO4 ; AS: PAS UTILISE!
    941       INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_ind  !Defines regions for SO2, BC & OM
    942       INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_bb   !Defines regions for SO2, BC & OM
    943       INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_dust !Defines  dust regions
    944       INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_wstardust !Defines  dust regions
    945 !$OMP THREADPRIVATE(iregion_so4,iregion_ind,iregion_bb,iregion_dust,iregion_wstardust)
    946 
    947 !  Emissions:
    948 
    949 !
    950 !---------------------------- SEA SALT & DUST emissions ------------------------
    951       REAL lmt_sea_salt(klon,ss_bins) !Sea salt 0.03-8.0 um
    952       REAL u10m_ec1(klon),v10m_ec1(klon)
    953       REAL u10m_ec2(klon),v10m_ec2(klon),dust_ec2(klon)
    954       REAL dust_ec(klon)
    955 !     new dust emission chimere je20140522
    956       REAL,DIMENSION(klon),INTENT(IN)                     :: zu10m
    957       REAL,DIMENSION(klon),INTENT(IN)                     :: zv10m
    958       REAL,DIMENSION(klon),INTENT(IN)  :: wstar,ale_bl,ale_wake
    959 
    960 
    961 !
    962 !  Rem : nbtr : nombre de vrais traceurs est defini dans dimphy.h
    963 
    964 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    965      !Dynamique
    966      !--------
    967       REAL,DIMENSION(klon,klev,nbtr),INTENT(IN)    :: d_tr_dyn
    968 
    969 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    970 !  convection:
    971 !  -----------
    972 !
    973       REAL , intent(in) :: pmfu(klon,klev)  ! flux de masse dans le panache montant
    974       REAL , intent(in) :: pmfd(klon,klev)  ! flux de masse dans le panache descendant
    975       REAL, intent(in) ::  pen_u(klon,klev) ! flux entraine dans le panache montant
    976       REAL, intent(in) ::  pde_u(klon,klev) ! flux detraine dans le panache montant
    977       REAL, intent(in) ::  pen_d(klon,klev) ! flux entraine dans le panache descendant
    978       REAL, intent(in) ::  pde_d(klon,klev) ! flux detraine dans le panache descendant
    979 !
    980 !  Convection KE scheme:
    981 !  ---------------------
    982 !
    983 !! Variables pour le lessivage convectif
    984        REAL,DIMENSION(klon,klev),INTENT(IN)     :: da
    985        REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi
    986        REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2
    987        REAL,DIMENSION(klon,klev),INTENT(IN)      :: d1a,dam
    988        REAL,DIMENSION(klon,klev),INTENT(IN)     :: mp
    989        REAL,DIMENSION(klon,klev),INTENT(IN)     :: upwd      ! saturated
    990 !            updraft mass flux
    991        REAL,DIMENSION(klon,klev),INTENT(IN)     :: dnwd      ! saturated
    992 !            downdraft mass flux
    993        INTEGER,DIMENSION(klon),INTENT(IN)     :: itop_con
    994        INTEGER,DIMENSION(klon),INTENT(IN)     :: ibas_con
    995        REAL,DIMENSION(klon,klev)      :: evapls
    996        REAL,DIMENSION(klon,klev),INTENT(IN)      :: wdtrainA
    997        REAL,DIMENSION(klon,klev),INTENT(IN)      :: wdtrainM
    998 
    999 
    1000        REAL,DIMENSION(klon,klev),INTENT(IN)      :: ep
    1001        REAL,DIMENSION(klon),INTENT(IN)           :: sigd
    1002        REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij
    1003        REAL,DIMENSION(klon,klev),INTENT(IN)      :: clw
    1004        REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij
    1005        REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm
    1006        REAL,DIMENSION(klon,klev),INTENT(IN)      :: eplaMm
    1007        REAL,DIMENSION(klon,klev),INTENT(IN)      :: wght_cvfd          !RL
    1008 
    1009 
    1010 !     KE: Tendances de traceurs (Td) et flux de traceurs:
    1011 !     ------------------------
    1012        REAL,DIMENSION(klon,klev)      :: Mint
    1013        REAL,DIMENSION(klon,klev,nbtr) :: zmfd1a
    1014        REAL,DIMENSION(klon,klev,nbtr) :: zmfdam
    1015        REAL,DIMENSION(klon,klev,nbtr) :: zmfphi2
    1016 
    1017 !                                                        !tra dans pluie LS a la surf.
    1018 !      outputs for cvltr_spl
    1019        REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cv_o 
    1020        REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_trsp_o
    1021        REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sscav_o
    1022        REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sat_o
    1023        REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_uscav_o
    1024      !!!!!!!!!!!!!!!!!
    1025      !!!!!!!!!!!!!!!!!
    1026      !!!!!!!!!!!!!!!!!
    1027        REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_insc_o
    1028        REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_bcscav_o
    1029        REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_evapls_o
    1030        REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_ls_o
    1031        REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_dyn_o
    1032        REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cl_o
    1033        REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_th_o
    1034      !!!!!!!!!!!!!!!!!
    1035      !!!!!!!!!!!!!!!!!
    1036      !!!!!!!!!!!!!!!!!
    1037 
    1038 !$OMP THREADPRIVATE(d_tr_cv_o,d_tr_trsp_o,d_tr_sscav_o,d_tr_sat_o,d_tr_uscav_o)
    1039 !$OMP THREADPRIVATE(d_tr_insc_o,d_tr_bcscav_o,d_tr_evapls_o,d_tr_ls_o)
    1040 !$OMP THREADPRIVATE(d_tr_dyn_o,d_tr_cl_o,d_tr_th_o)
    1041 
    1042 
    1043        INTEGER ::  nsplit
    1044 !
    1045 
    1046      
    1047 
    1048 !
    1049 !  Lessivage
    1050 !  ---------
    1051 !
    1052       REAL, intent(in) ::  pmflxr(klon,klev+1), pmflxs(klon,klev+1)   !--convection
    1053       REAL, intent(in) ::  prfl(klon,klev+1),   psfl(klon,klev+1)     !--large-scale
    1054       REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb
    1055       REAL  :: ql_incloud_ref    ! ref value of in-cloud condensed water content
    1056 
    1057        REAL,DIMENSION(klon,klev),INTENT(IN)   :: rneb    ! fraction nuageuse (grande echelle)
    1058 !
    1059 
    1060       REAL,DIMENSION(klon,klev) :: beta_fisrt ! taux de conversion
    1061 !                                                          ! de l'eau cond (de fisrtilp)
    1062       REAL,DIMENSION(klon,klev) :: beta_v1    ! -- (originale version)
    1063       INTEGER,SAVE  :: iflag_lscav_omp,iflag_lscav
    1064 !$OMP THREADPRIVATE(iflag_lscav_omp,iflag_lscav)
    1065 
    1066 
    1067 
    1068 
    1069 !Thermiques:
    1070 !----------
    1071       REAL,DIMENSION(klon,klev+1),INTENT(IN)   :: fm_therm
    1072       REAL,DIMENSION(klon,klev),INTENT(INOUT)     :: entr_therm
    1073 
    1074 
    1075 !
    1076 !  Couche limite:
    1077 !  --------------
    1078 !
    1079       REAL , intent(in) :: coefh(klon,klev) ! coeff melange CL
    1080       REAL , intent(in) :: cdragh(klon), cdragm(klon)
    1081       REAL, intent(in) ::  yu1(klon)        ! vent dans la 1iere couche
    1082       REAL, intent(in) ::  yv1(klon)        ! vent dans la 1iere couche
    1083 !
    1084 !
    1085 !----------------------------------------------------------------------
    1086       REAL his_ds(klon,nbtr)
    1087       REAL his_dh(klon,nbtr)
    1088       REAL his_dhlsc(klon,nbtr)        ! in-cloud scavenging lsc
    1089       REAL his_dhcon(klon,nbtr)       ! in-cloud scavenging con
    1090       REAL his_dhbclsc(klon,nbtr)      ! below-cloud scavenging lsc
    1091       REAL his_dhbccon(klon,nbtr)      ! below-cloud scavenging con
    1092       REAL trm(klon,nbtr)
    1093 !
    1094       REAL u10m_ec(klon), v10m_ec(klon)
    1095 !
    1096       REAL his_th(klon,nbtr)
    1097       REAL his_dhkecv(klon,nbtr)
    1098       REAL his_dhkelsc(klon,nbtr)
    1099 
    1100 
    1101 !
    1102 !  Coordonnees
    1103 !  -----------
    1104 !
    1105       REAL, intent(in) ::  rlat(klon)       ! latitudes pour chaque point
    1106       REAL, intent(in) ::  rlon(klon)       ! longitudes pour chaque point
    1107 !
    1108       INTEGER i, k, iq, itr, j, ig
    1109 !
    1110 ! DEFINITION OF DIAGNOSTIC VARIABLES
    1111 !
    1112       REAL diag_trm(nbtr), diag_drydep(nbtr)
    1113       REAL diag_wetdep(nbtr), diag_cvtdep(nbtr)
    1114       REAL diag_emissn(nbtr), diag_g2part
    1115       REAL diag_sedimt
    1116       REAL trm_aux(nbtr), src_aux(nbtr)
    1117 !
    1118 ! Variables locales pour effectuer les appels en serie
    1119 !----------------------------------------------------
    1120       REAL source_tr(klon,nbtr)
    1121       REAL flux_tr(klon,nbtr)
    1122       REAL m_conc(klon,klev)
    1123       REAL henry(nbtr)  !--cste de Henry  mol/l/atm
    1124       REAL kk(nbtr)     !--coefficient de var avec T (K)
    1125       REAL alpha_r(nbtr)!--coefficient d'impaction pour la pluie
    1126       REAL alpha_s(nbtr)!--coefficient d'impaction pour la neige
    1127       REAL vdep_oce(nbtr), vdep_sic(nbtr)
    1128       REAL vdep_ter(nbtr), vdep_lic(nbtr)
    1129       REAL ccntrAA_spla(nbtr)
    1130       REAL ccntrENV_spla(nbtr)
    1131       REAL coefcoli_spla(nbtr)
    1132       REAL dtrconv(klon,nbtr)
    1133       REAL zrho(klon,klev), zdz(klon,klev)
    1134       REAL zalt(klon,klev)
    1135       REAL,DIMENSION(klon,klev)      :: zmasse    ! densité atmosphérique
    1136 !     .                                              Kg/m2
    1137       REAL,DIMENSION(klon,klev)      :: ztra_th
    1138       REAL qmin, qmax, aux
    1139 !      PARAMETER (qmin=0.0, qmax=1.e33)
    1140       PARAMETER (qmin=1.e33, qmax=-1.e33)
    1141 
    1142 ! Variables to save data into file
    1143 !----------------------------------
    1144    
    1145       CHARACTER*2 str2
    1146 !!AS:      LOGICAL ok_histrac
    1147 !!!JE2014124      PARAMETER (ok_histrac=.true.)
    1148 !!      PARAMETER (ok_histrac=.false.)
    1149       INTEGER ndex2d(iim*(jjm+1)), ndex3d(iim*(jjm+1)*klev)
    1150       INTEGER nhori1, nhori2, nhori3, nhori4, nhori5, nvert
    1151       INTEGER nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5
    1152       SAVE nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5
    1153 !$OMP THREADPRIVATE(nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5)
    1154       INTEGER itra
    1155       SAVE itra                    ! compteur pour la physique
    1156 !$OMP THREADPRIVATE(itra)
    1157       INTEGER ecrit_tra, ecrit_tra_h, ecrit_tra_m
    1158       SAVE ecrit_tra, ecrit_tra_h, ecrit_tra_m
    1159 !$OMP THREADPRIVATE(ecrit_tra, ecrit_tra_h, ecrit_tra_m)
    1160       REAL presnivs(klev) ! pressions approximat. des milieux couches ( en PA)
    1161       REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
    1162       REAL zx_tmp_fi2d(klon), zx_tmp_fi3d(klon, klev)
    1163       REAL zx_lon_glo(nbp_lon,nbp_lat), zx_lat_glo(nbp_lon,nbp_lat)
    1164       REAL zsto, zout, zout_h, zout_m, zjulian
    1165 
    1166 !------Molar Masses
    1167       REAL masse(nbtr)
    1168 !
    1169       REAL fracso2emis                              !--fraction so2 emis en so2
    1170       PARAMETER (fracso2emis=0.95)
    1171       REAL frach2sofso2                             !--fraction h2s from so2
    1172       PARAMETER (frach2sofso2=0.0426)
    1173 !
    1174 !  Controles
    1175 !-------------
    1176       LOGICAL convection,lessivage,lminmax,lcheckmass
    1177       DATA convection,lessivage,lminmax,lcheckmass &
    1178           /.true.,.true.,.true.,.false./
    1179 !
    1180       REAL xconv(nbtr)
    1181 !
    1182       LOGICAL anthropo, bateau, edgar
    1183       DATA anthropo,bateau,edgar/.true.,.true.,.true./
    1184 !
    1185 !c bc_source
    1186       INTEGER kminbc, kmaxbc
    1187 !JE20150715      PARAMETER (kminbc=3, kmaxbc=5)
    1188       PARAMETER (kminbc=4, kmaxbc=7)
    1189 !
    1190       REAL tr1_cont, tr2_cont, tr3_cont, tr4_cont
    1191 !
    1192 ! JE for updating in  cltrac
    1193       REAL,DIMENSION(klon,klev)             :: delp     ! epaisseur de couche (Pa)
    1194 !! JE for include gas to particle conversion in output
    1195 !      REAL his_g2pgas(klon)      ! gastoparticle in gas units (check!)
    1196 !      REAL his_g2paer(klon)      ! gastoparticle in aerosol units (check!)
    1197 !
    1198       INTEGER ,intent(in) :: iflag_conv
    1199       LOGICAL iscm3  ! debug variable. for checkmass ! JE
    1200 
    1201 !------------------------------------------------------------------------
    1202 !  only to compute time consumption of each process
    1203 !----
    1204       INTEGER clock_start,clock_end,clock_rate,clock_start_spla
    1205       INTEGER clock_end_outphytracr,clock_start_outphytracr
    1206       INTEGER ti_init,dife,ti_inittype,ti_inittwrite
    1207       INTEGER ti_spla,ti_emis,ti_depo,ti_cltr,ti_ther
    1208       INTEGER ti_sedi,ti_gasp,ti_wetap,ti_cvltr,ti_lscs,ti_brop,ti_outs
    1209       INTEGER ti_nophytracr,clock_per_max
    1210       REAL tia_init,tia_inittype,tia_inittwrite
    1211       REAL tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther
    1212       REAL tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs
    1213       REAL tia_brop,tia_outs
    1214       REAL tia_nophytracr
    1215  
    1216       SAVE tia_init,tia_inittype,tia_inittwrite
    1217       SAVE tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther
    1218       SAVE tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs
    1219       SAVE tia_brop,tia_outs
    1220       SAVE ti_nophytracr
    1221       SAVE tia_nophytracr
    1222       SAVE clock_end_outphytracr,clock_start_outphytracr
    1223       SAVE clock_per_max
    1224       LOGICAL logitime
    1225 !$OMP THREADPRIVATE(tia_init,tia_inittype,tia_inittwrite)
    1226 !$OMP THREADPRIVATE(tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther)
    1227 !$OMP THREADPRIVATE(tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs)
    1228 !$OMP THREADPRIVATE(tia_brop,tia_outs)
    1229 !$OMP THREADPRIVATE(ti_nophytracr)
    1230 !$OMP THREADPRIVATE(tia_nophytracr)
    1231 !$OMP THREADPRIVATE(clock_end_outphytracr,clock_start_outphytracr)
    1232 !$OMP THREADPRIVATE(clock_per_max)
    1233 
    1234 !     utils parallelization
    1235       REAL :: auxklon_glo(klon_glo)
    1236       INTEGER :: iauxklon_glo(klon_glo)
    1237       REAL, DIMENSION(klon_glo,nbp_lev) :: auxklonnbp_lev
    1238       REAL, DIMENSION(klon_glo,nbp_lev,nbtr)  :: auxklonklevnbtr_glo
    1239       REAL,DIMENSION(nbp_lon,nbp_lat) ::  zx_tmp_2d_glo
    1240       REAL,DIMENSION(nbp_lon,nbp_lat,nbp_lev) :: zx_tmp_3d_glo
    1241       REAL,DIMENSION(klon_glo) :: zx_tmp_fi2d_glo
    1242       REAL,DIMENSION(klon_glo , nbp_lev) :: zx_tmp_fi3d_glo
    1243       REAL,DIMENSION(klon_glo,nbtr) :: auxklonnbtr_glo
    1244 
    1245 
    1246 
    1247       source_tr=0.
    1248 
    1249 
    1250 
    1251       if (debutphy) then
     434    CALL dustemis_out_init()
     435
     436    !traceur
     437    ALLOCATE(diff_aod550_tot(klon))
     438    ALLOCATE(diag_aod670_tot(klon))
     439    ALLOCATE(diag_aod865_tot(klon))
     440    ALLOCATE(diff_aod550_tr2(klon))
     441    ALLOCATE(diag_aod670_tr2(klon))
     442    ALLOCATE(diag_aod865_tr2(klon))
     443    ALLOCATE(diag_aod550_ss(klon))
     444    ALLOCATE(diag_aod670_ss(klon))
     445    ALLOCATE(diag_aod865_ss(klon))
     446    ALLOCATE(diag_aod550_dust(klon))
     447    ALLOCATE(diag_aod670_dust(klon))
     448    ALLOCATE(diag_aod865_dust(klon))
     449    ALLOCATE(diag_aod550_dustsco(klon))
     450    ALLOCATE(diag_aod670_dustsco(klon))
     451    ALLOCATE(diag_aod865_dustsco(klon))
     452    !AS: les 15 vars _terra et 15 _aqua suivantes sont groupees differemment dans spla_output_write.h
     453    ALLOCATE(aod550_terra(klon))
     454    ALLOCATE(aod550_tr2_terra(klon))
     455    ALLOCATE(aod550_ss_terra(klon))
     456    ALLOCATE(aod550_dust_terra(klon))
     457    ALLOCATE(aod550_dustsco_terra(klon))
     458    ALLOCATE(aod670_terra(klon))
     459    ALLOCATE(aod670_tr2_terra(klon))
     460    ALLOCATE(aod670_ss_terra(klon))
     461    ALLOCATE(aod670_dust_terra(klon))
     462    ALLOCATE(aod670_dustsco_terra(klon))
     463    ALLOCATE(aod865_terra(klon))
     464    ALLOCATE(aod865_tr2_terra(klon))
     465    ALLOCATE(aod865_ss_terra(klon))
     466    ALLOCATE(aod865_dust_terra(klon))
     467    ALLOCATE(aod865_dustsco_terra(klon))
     468
     469    ALLOCATE(aod550_aqua(klon))
     470    ALLOCATE(aod550_tr2_aqua(klon))
     471    ALLOCATE(aod550_ss_aqua(klon))
     472    ALLOCATE(aod550_dust_aqua(klon))
     473    ALLOCATE(aod550_dustsco_aqua(klon))
     474    ALLOCATE(aod670_aqua(klon))
     475    ALLOCATE(aod670_tr2_aqua(klon))
     476    ALLOCATE(aod670_ss_aqua(klon))
     477    ALLOCATE(aod670_dust_aqua(klon))
     478    ALLOCATE(aod670_dustsco_aqua(klon))
     479    ALLOCATE(aod865_aqua(klon))
     480    ALLOCATE(aod865_tr2_aqua(klon))
     481    ALLOCATE(aod865_ss_aqua(klon))
     482    ALLOCATE(aod865_dust_aqua(klon))
     483    ALLOCATE(aod865_dustsco_aqua(klon))
     484
     485    ALLOCATE(sconc01(klon))
     486    ALLOCATE(trm01(klon))
     487    ALLOCATE(sconc02(klon))
     488    ALLOCATE(trm02(klon))
     489    ALLOCATE(sconc03(klon))
     490    ALLOCATE(trm03(klon))
     491    ALLOCATE(sconc04(klon))
     492    ALLOCATE(trm04(klon))
     493    ALLOCATE(sconc05(klon))
     494    ALLOCATE(trm05(klon))
     495
     496    ! Lessivage
     497    ALLOCATE(flux01(klon))
     498    ALLOCATE(flux02(klon))
     499    ALLOCATE(flux03(klon))
     500    ALLOCATE(flux04(klon))
     501    ALLOCATE(flux05(klon))
     502    ALLOCATE(ds01(klon))
     503    ALLOCATE(ds02(klon))
     504    ALLOCATE(ds03(klon))
     505    ALLOCATE(ds04(klon))
     506    ALLOCATE(ds05(klon))
     507    ALLOCATE(dh01(klon))
     508    ALLOCATE(dh02(klon))
     509    ALLOCATE(dh03(klon))
     510    ALLOCATE(dh04(klon))
     511    ALLOCATE(dh05(klon))
     512    ALLOCATE(dtrconv01(klon))
     513    ALLOCATE(dtrconv02(klon))
     514    ALLOCATE(dtrconv03(klon))
     515    ALLOCATE(dtrconv04(klon))
     516    ALLOCATE(dtrconv05(klon))
     517    ALLOCATE(dtherm01(klon))
     518    ALLOCATE(dtherm02(klon))
     519    ALLOCATE(dtherm03(klon))
     520    ALLOCATE(dtherm04(klon))
     521    ALLOCATE(dtherm05(klon))
     522    ALLOCATE(dhkecv01(klon))
     523    ALLOCATE(dhkecv02(klon))
     524    ALLOCATE(dhkecv03(klon))
     525    ALLOCATE(dhkecv04(klon))
     526    ALLOCATE(dhkecv05(klon))
     527    ALLOCATE(d_tr_ds01(klon))
     528    ALLOCATE(d_tr_ds02(klon))
     529    ALLOCATE(d_tr_ds03(klon))
     530    ALLOCATE(d_tr_ds04(klon))
     531    ALLOCATE(d_tr_ds05(klon))
     532    ALLOCATE(dhkelsc01(klon))
     533    ALLOCATE(dhkelsc02(klon))
     534    ALLOCATE(dhkelsc03(klon))
     535    ALLOCATE(dhkelsc04(klon))
     536    ALLOCATE(dhkelsc05(klon))
     537    ALLOCATE(d_tr_cv01(klon, klev))
     538    ALLOCATE(d_tr_cv02(klon, klev))
     539    ALLOCATE(d_tr_cv03(klon, klev))
     540    ALLOCATE(d_tr_cv04(klon, klev))
     541    ALLOCATE(d_tr_cv05(klon, klev))
     542    ALLOCATE(d_tr_trsp01(klon, klev))
     543    ALLOCATE(d_tr_trsp02(klon, klev))
     544    ALLOCATE(d_tr_trsp03(klon, klev))
     545    ALLOCATE(d_tr_trsp04(klon, klev))
     546    ALLOCATE(d_tr_trsp05(klon, klev))
     547    ALLOCATE(d_tr_sscav01(klon, klev))
     548    ALLOCATE(d_tr_sscav02(klon, klev))
     549    ALLOCATE(d_tr_sscav03(klon, klev))
     550    ALLOCATE(d_tr_sscav04(klon, klev))
     551    ALLOCATE(d_tr_sscav05(klon, klev))
     552    ALLOCATE(d_tr_sat01(klon, klev))
     553    ALLOCATE(d_tr_sat02(klon, klev))
     554    ALLOCATE(d_tr_sat03(klon, klev))
     555    ALLOCATE(d_tr_sat04(klon, klev))
     556    ALLOCATE(d_tr_sat05(klon, klev))
     557    ALLOCATE(d_tr_uscav01(klon, klev))
     558    ALLOCATE(d_tr_uscav02(klon, klev))
     559    ALLOCATE(d_tr_uscav03(klon, klev))
     560    ALLOCATE(d_tr_uscav04(klon, klev))
     561    ALLOCATE(d_tr_uscav05(klon, klev))
     562    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     563    ALLOCATE(d_tr_insc01(klon, klev))
     564    ALLOCATE(d_tr_insc02(klon, klev))
     565    ALLOCATE(d_tr_insc03(klon, klev))
     566    ALLOCATE(d_tr_insc04(klon, klev))
     567    ALLOCATE(d_tr_insc05(klon, klev))
     568    ALLOCATE(d_tr_bcscav01(klon, klev))
     569    ALLOCATE(d_tr_bcscav02(klon, klev))
     570    ALLOCATE(d_tr_bcscav03(klon, klev))
     571    ALLOCATE(d_tr_bcscav04(klon, klev))
     572    ALLOCATE(d_tr_bcscav05(klon, klev))
     573    ALLOCATE(d_tr_evapls01(klon, klev))
     574    ALLOCATE(d_tr_evapls02(klon, klev))
     575    ALLOCATE(d_tr_evapls03(klon, klev))
     576    ALLOCATE(d_tr_evapls04(klon, klev))
     577    ALLOCATE(d_tr_evapls05(klon, klev))
     578    ALLOCATE(d_tr_ls01(klon, klev))
     579    ALLOCATE(d_tr_ls02(klon, klev))
     580    ALLOCATE(d_tr_ls03(klon, klev))
     581    ALLOCATE(d_tr_ls04(klon, klev))
     582    ALLOCATE(d_tr_ls05(klon, klev))
     583
     584    ALLOCATE(d_tr_dyn01(klon, klev))
     585    ALLOCATE(d_tr_dyn02(klon, klev))
     586    ALLOCATE(d_tr_dyn03(klon, klev))
     587    ALLOCATE(d_tr_dyn04(klon, klev))
     588    ALLOCATE(d_tr_dyn05(klon, klev))
     589
     590    ALLOCATE(d_tr_cl01(klon, klev))
     591    ALLOCATE(d_tr_cl02(klon, klev))
     592    ALLOCATE(d_tr_cl03(klon, klev))
     593    ALLOCATE(d_tr_cl04(klon, klev))
     594    ALLOCATE(d_tr_cl05(klon, klev))
     595    ALLOCATE(d_tr_th01(klon, klev))
     596    ALLOCATE(d_tr_th02(klon, klev))
     597    ALLOCATE(d_tr_th03(klon, klev))
     598    ALLOCATE(d_tr_th04(klon, klev))
     599    ALLOCATE(d_tr_th05(klon, klev))
     600
     601    ALLOCATE(sed_ss(klon))
     602    ALLOCATE(sed_dust(klon))
     603    ALLOCATE(sed_dustsco(klon))
     604    ALLOCATE(his_g2pgas(klon))
     605    ALLOCATE(his_g2paer(klon))
     606
     607    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     608    ALLOCATE(sed_ss3D(klon, klev))
     609    ALLOCATE(sed_dust3D(klon, klev))
     610    ALLOCATE(sed_dustsco3D(klon, klev))
     611    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     612
     613    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     614    ! histrac_spl
     615
     616    ALLOCATE(fluxbb(klon))
     617    ALLOCATE(fluxff(klon))
     618    ALLOCATE(fluxbcbb(klon))
     619    ALLOCATE(fluxbcff(klon))
     620    ALLOCATE(fluxbcnff(klon))
     621    ALLOCATE(fluxbcba(klon))
     622    ALLOCATE(fluxbc(klon))
     623    ALLOCATE(fluxombb(klon))
     624    ALLOCATE(fluxomff(klon))
     625    ALLOCATE(fluxomnff(klon))
     626    ALLOCATE(fluxomba(klon))
     627    ALLOCATE(fluxomnat(klon))
     628    ALLOCATE(fluxom(klon))
     629    ALLOCATE(fluxh2sff(klon))
     630    ALLOCATE(fluxh2snff(klon))
     631    ALLOCATE(fluxso2ff(klon))
     632    ALLOCATE(fluxso2nff(klon))
     633    ALLOCATE(fluxso2bb(klon))
     634    ALLOCATE(fluxso2vol(klon))
     635    ALLOCATE(fluxso2ba(klon))
     636    ALLOCATE(fluxso2(klon))
     637    ALLOCATE(fluxso4ff(klon))
     638    ALLOCATE(fluxso4nff(klon))
     639    ALLOCATE(fluxso4bb(klon))
     640    ALLOCATE(fluxso4ba(klon))
     641    ALLOCATE(fluxso4(klon))
     642    ALLOCATE(fluxdms(klon))
     643    ALLOCATE(fluxh2sbio(klon))
     644    ALLOCATE(fluxdustec(klon))
     645    ALLOCATE(fluxddfine(klon))
     646    ALLOCATE(fluxddcoa(klon))
     647    ALLOCATE(fluxddsco(klon))
     648    ALLOCATE(fluxdd(klon))
     649    ALLOCATE(fluxssfine(klon))
     650    ALLOCATE(fluxsscoa(klon))
     651    ALLOCATE(fluxss(klon))
     652    ALLOCATE(flux_sparam_ind(klon))
     653    ALLOCATE(flux_sparam_bb(klon))
     654    ALLOCATE(flux_sparam_ff(klon))
     655    ALLOCATE(flux_sparam_ddfine(klon))
     656    ALLOCATE(flux_sparam_ddcoa(klon))
     657    ALLOCATE(flux_sparam_ddsco(klon))
     658    ALLOCATE(flux_sparam_ssfine(klon))
     659    ALLOCATE(flux_sparam_sscoa(klon))
     660    ALLOCATE(u10m_ss(klon))
     661    ALLOCATE(v10m_ss(klon))
     662
     663    !AS: in phys_output_write_spl, but not in spla_output_write.h
     664    !------------------------------------------------------
     665    ALLOCATE(d_tr_cl(klon, klev, nbtr))
     666    ALLOCATE(d_tr_th(klon, klev, nbtr))
     667    ALLOCATE(d_tr_cv(klon, klev, nbtr))
     668    ALLOCATE(d_tr_lessi_impa(klon, klev, nbtr))
     669    ALLOCATE(d_tr_lessi_nucl(klon, klev, nbtr))
     670    ALLOCATE(d_tr_insc(klon, klev, nbtr))
     671    ALLOCATE(d_tr_bcscav(klon, klev, nbtr))
     672    ALLOCATE(d_tr_evapls(klon, klev, nbtr))
     673    ALLOCATE(d_tr_ls(klon, klev, nbtr))
     674    ALLOCATE(d_tr_trsp(klon, klev, nbtr))
     675    ALLOCATE(d_tr_sscav(klon, klev, nbtr))
     676    ALLOCATE(d_tr_sat(klon, klev, nbtr))
     677    ALLOCATE(d_tr_uscav(klon, klev, nbtr))
     678
     679  END SUBROUTINE phytracr_spl_out_init
     680
     681  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     682  SUBROUTINE phytracr_spl_ini(klon, nbreg_ind, nbreg_bb, nbreg_dust, nbreg_wstardust)
     683    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     684
     685    IMPLICIT NONE
     686    INTEGER klon, nbreg_ind, nbreg_bb, nbreg_dust, nbreg_wstardust
     687
     688    ALLOCATE(tsol(klon))
     689
     690    !AS: IF permettant le debranchage des coefs de Jeronimo Escribano: fichiers *_meta
     691    ! nbreg_* sont initialisés à 1 dans phytracr_spl, if debutphy,
     692    ! avant d'appeler la subroutine presente, phytracr_spl_ini
     693    ! (phytracr_spl_ini appele readregionsdims2_spl,
     694    ! qui lit et fait "bcast" de nbreg_ind,_bb,_dust,_wstardust dans fichiers regions_*_meta)
     695    IF("ASSIM"=="YES") THEN
     696      fileregionsdimsind = 'regions_ind_meta'
     697      fileregionsdimsdust = 'regions_dustacc_meta'
     698      !  fileregionsdimsdust='regions_dust_meta'
     699      fileregionsdimsbb = 'regions_bb_meta'
     700      fileregionsdimswstar = 'regions_pwstarwake_meta'
     701      call  readregionsdims2_spl(nbreg_ind, fileregionsdimsind)
     702      call  readregionsdims2_spl(nbreg_dust, fileregionsdimsdust)
     703      call  readregionsdims2_spl(nbreg_bb, fileregionsdimsbb)
     704      call  readregionsdims2_spl(nbreg_wstardust, fileregionsdimswstar)
     705    ENDIF ! ASSIM
     706    ! fin debranchage
     707
     708    !readregions_spl()
     709
     710    ALLOCATE(scale_param_ind(nbreg_ind))
     711    ALLOCATE(scale_param_bb(nbreg_bb))
     712    ALLOCATE(scale_param_ff(nbreg_ind))
     713    ALLOCATE(scale_param_dustacc(nbreg_dust))
     714    ALLOCATE(scale_param_dustcoa(nbreg_dust))
     715    ALLOCATE(scale_param_dustsco(nbreg_dust))
     716    ALLOCATE(param_wstarBLperregion(nbreg_wstardust))
     717    ALLOCATE(param_wstarWAKEperregion(nbreg_wstardust))
     718    ALLOCATE(dust_ec(klon))
     719    ALLOCATE(u10m_ec(klon))
     720    ALLOCATE(v10m_ec(klon))
     721    ALLOCATE(lmt_so2volc_cont(klon))
     722    ALLOCATE(lmt_altvolc_cont(klon))
     723    ALLOCATE(lmt_so2volc_expl(klon))
     724    ALLOCATE(lmt_altvolc_expl(klon))
     725    ALLOCATE(lmt_so2ff_l(klon))
     726    ALLOCATE(lmt_so2ff_h(klon))
     727    ALLOCATE(lmt_so2nff(klon))
     728    ALLOCATE(lmt_so2ba(klon))
     729    ALLOCATE(lmt_so2bb_l(klon))
     730    ALLOCATE(lmt_so2bb_h(klon))
     731    ALLOCATE(lmt_dmsconc(klon))
     732    ALLOCATE(lmt_dmsbio(klon))
     733    ALLOCATE(lmt_h2sbio(klon))
     734    ALLOCATE(lmt_bcff(klon))
     735    ALLOCATE(lmt_bcnff(klon))
     736    ALLOCATE(lmt_bcbb_l(klon))
     737    ALLOCATE(lmt_bcbb_h(klon))
     738    ALLOCATE(lmt_bcba(klon))
     739    ALLOCATE(lmt_omff(klon))
     740    ALLOCATE(lmt_omnff(klon))
     741    ALLOCATE(lmt_ombb_l(klon))
     742    ALLOCATE(lmt_ombb_h(klon))
     743    ALLOCATE(lmt_omnat(klon))
     744    ALLOCATE(lmt_omba(klon))
     745    ALLOCATE(lmt_sea_salt(klon, ss_bins))
     746
     747
     748
     749
     750    !temporal hardcoded null inicialization of assimilation emmision factors
     751    !AS: scale_param sont ensuite lus dans modvalues.nc
     752    ! par la subroutine read_scalenc, appelee par readscaleparamsnc_spl
     753    scale_param_ssacc = 1.
     754    scale_param_sscoa = 1.
     755    scale_param_ind(:) = 1.
     756    scale_param_bb(:) = 1.
     757    scale_param_ff(:) = 1.
     758    scale_param_dustacc(:) = 1.
     759    scale_param_dustcoa(:) = 1.
     760    scale_param_dustsco(:) = 1.
     761    param_wstarBLperregion(:) = 0.
     762    param_wstarWAKEperregion(:) = 0.
     763
     764    RETURN
     765  END SUBROUTINE phytracr_spl_ini
     766
     767
     768  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     769  SUBROUTINE phytracr_spl (debutphy, lafin, jD_cur, jH_cur, iflag_conv, &  ! I
     770          pdtphys, ftsol, &  ! I
     771          t_seri, q_seri, paprs, pplay, RHcl, &  ! I
     772          pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &  ! I
     773          coefh, cdragh, cdragm, yu1, yv1, &  ! I
     774          u_seri, v_seri, rlat, rlon, &  ! I
     775          pphis, pctsrf, pmflxr, pmflxs, prfl, psfl, &  ! I
     776          da, phi, phi2, d1a, dam, mp, ep, sigd, sij, clw, elij, &  ! I
     777          epmlmMm, eplaMm, upwd, dnwd, itop_con, ibas_con, &  ! I
     778          evapls, wdtrainA, wdtrainM, wght_cvfd, &  ! I
     779          fm_therm, entr_therm, rneb, &  ! I
     780          beta_fisrt, beta_v1, &  ! I
     781          zu10m, zv10m, wstar, ale_bl, ale_wake, &  ! I
     782          d_tr_dyn, tr_seri)                                            ! O
     783    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     784
     785    USE mod_grid_phy_lmdz
     786    USE mod_phys_lmdz_para
     787    USE IOIPSL
     788    USE dimphy
     789    USE infotrac
     790    USE indice_sol_mod
     791    USE write_field_phy
     792
     793    USE mod_phys_lmdz_transfert_para
     794    USE lmdz_thermcell_dq, ONLY : thermcell_dq
     795    USE phys_cal_mod, only : jD_1jan, year_len, mth_len, days_elapsed, jh_1jan, year_cur, &
     796            mth_cur, phys_cal_update
     797
     798    USE lmdz_yomcst
     799
     800    IMPLICIT none
     801
     802    !======================================================================
     803    ! Auteur(s) FH
     804    ! Objet: Moniteur general des tendances traceurs
     805
     806    ! Remarques en vrac:
     807    ! ------------------
     808    ! 1/ le call phytrac se fait avec nqmax-2 donc nous avons bien
     809    ! les vrais traceurs (nbtr) dans phytrac (pas la vapeur ni eau liquide)
     810    !! AS : nqmax-2 devrait etre nqmax-3 apres introducton de H2Oi ;
     811    !!   et c'est encore different avec le parser de DC ?
     812    !======================================================================
     813    INCLUDE "dimensions.h"
     814    INCLUDE "chem.h"
     815    INCLUDE "chem_spla.h"
     816    INCLUDE "YOETHF.h"
     817    INCLUDE "paramet.h"
     818    INCLUDE "alpale.h"
     819
     820    !======================================================================
     821
     822    ! Arguments:
     823
     824    !  EN ENTREE:
     825    !  ==========
     826
     827    !  divers:
     828    !  -------
     829
     830    real, intent(in) :: pdtphys  ! pas d'integration pour la physique (seconde)
     831    REAL, intent(in) :: jD_cur, jH_cur
     832    real, intent(in) :: ftsol(klon, nbsrf)  ! temperature du sol par type
     833    real, intent(in) :: t_seri(klon, klev)  ! temperature
     834    real, intent(in) :: u_seri(klon, klev)  ! vent
     835    real, intent(in) :: v_seri(klon, klev)  ! vent
     836    real, intent(in) :: q_seri(klon, klev)  ! vapeur d eau kg/kg
     837
     838    LOGICAL, INTENT(IN) :: lafin
     839
     840    real tr_seri(klon, klev, nbtr) ! traceur
     841    real tmp_var(klon, klev) ! auxiliary variable to replace traceur
     842    real tmp_var2(klon, nbtr) ! auxiliary variable to replace source
     843    real tmp_var3(klon, klev, nbtr) ! auxiliary variable 3D
     844    real dummy1d ! JE auxiliary variable
     845    real aux_var2(klon) ! auxiliary variable to replace traceur
     846    real aux_var3(klon, klev) ! auxiliary variable to replace traceur
     847    real d_tr(klon, klev, nbtr)    ! traceur  tendance
     848    real sconc_seri(klon, nbtr) ! surface concentration of traceur
     849
     850    integer nbjour
     851    save nbjour
     852    !$OMP THREADPRIVATE(nbjour)
     853
     854    INTEGER  masque_aqua_cur(klon)
     855    INTEGER  masque_terra_cur(klon)
     856    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: masque_aqua  !mask for 1 day
     857    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: masque_terra !
     858    !$OMP THREADPRIVATE(masque_aqua,masque_terra)
     859
     860    INTEGER, SAVE :: nbreg_dust, nbreg_ind, nbreg_bb, nbreg_ss, nbreg_wstardust
     861    !$OMP THREADPRIVATE(nbreg_dust, nbreg_ind, nbreg_bb,nbreg_ss,nbreg_wstardust)
     862
     863    REAL lmt_dms(klon)           ! emissions de dms
     864
     865    !JE20150518<<
     866    REAL, DIMENSION(klon_glo) :: aod550_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
     867    REAL, DIMENSION(klon_glo) :: aod550_tr2_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
     868    REAL, DIMENSION(klon_glo) :: aod550_ss_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
     869    REAL, DIMENSION(klon_glo) :: aod550_dust_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
     870    REAL, DIMENSION(klon_glo) :: aod550_dustsco_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
     871    REAL, DIMENSION(klon_glo) :: aod670_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
     872    REAL, DIMENSION(klon_glo) :: aod670_tr2_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
     873    REAL, DIMENSION(klon_glo) :: aod670_ss_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
     874    REAL, DIMENSION(klon_glo) :: aod670_dust_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
     875    REAL, DIMENSION(klon_glo) :: aod670_dustsco_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
     876    REAL, DIMENSION(klon_glo) :: aod865_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
     877    REAL, DIMENSION(klon_glo) :: aod865_tr2_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
     878    REAL, DIMENSION(klon_glo) :: aod865_ss_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
     879    REAL, DIMENSION(klon_glo) :: aod865_dust_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
     880    REAL, DIMENSION(klon_glo) :: aod865_dustsco_terra_glo  ! AOD at terra overpass time ( 10.30 local hour)
     881
     882    REAL, DIMENSION(klon_glo) :: aod550_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
     883    REAL, DIMENSION(klon_glo) :: aod550_tr2_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
     884    REAL, DIMENSION(klon_glo) :: aod550_ss_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
     885    REAL, DIMENSION(klon_glo) :: aod550_dust_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
     886    REAL, DIMENSION(klon_glo) :: aod550_dustsco_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
     887    REAL, DIMENSION(klon_glo) :: aod670_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
     888    REAL, DIMENSION(klon_glo) :: aod670_tr2_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
     889    REAL, DIMENSION(klon_glo) :: aod670_ss_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
     890    REAL, DIMENSION(klon_glo) :: aod670_dust_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
     891    REAL, DIMENSION(klon_glo) :: aod670_dustsco_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
     892    REAL, DIMENSION(klon_glo) :: aod865_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
     893    REAL, DIMENSION(klon_glo) :: aod865_tr2_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
     894    REAL, DIMENSION(klon_glo) :: aod865_ss_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
     895    REAL, DIMENSION(klon_glo) :: aod865_dust_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
     896    REAL, DIMENSION(klon_glo) :: aod865_dustsco_aqua_glo  ! AOD at aqua overpass time ( 13.30 local hour)
     897    !!!!!!!!!!!!!
     898    !JE20150518>>
     899
     900    real, intent(in) :: paprs(klon, klev + 1)  ! pression pour chaque inter-couche (en Pa)
     901    real, intent(in) :: pplay(klon, klev)  ! pression pour le mileu de chaque couche (en Pa)
     902    real, intent(in) :: RHcl(klon, klev)  ! humidite relativen ciel clair
     903    real znivsig(klev)  ! indice des couches
     904    real paire(klon)
     905    real, intent(in) :: pphis(klon)
     906    real, intent(in) :: pctsrf(klon, nbsrf)
     907    logical, intent(in) :: debutphy   ! le flag de l'initialisation de la physique
     908
     909    !  Scaling Parameters:
     910    !  ----------------------
     911
     912    CHARACTER*50 c_Directory
     913    CHARACTER*80 c_FileName1
     914    CHARACTER*80 c_FileName2
     915    CHARACTER*130 c_FullName1
     916    CHARACTER*130 c_FullName2
     917    INTEGER :: xidx, yidx
     918    INTEGER, DIMENSION(klon) :: mask_bbreg
     919    INTEGER, DIMENSION(klon) :: mask_ffso2reg
     920    INTEGER :: aux_mask1
     921    INTEGER :: aux_mask2
     922    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_so4 !Defines regions for SO4 ; AS: PAS UTILISE!
     923    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_ind  !Defines regions for SO2, BC & OM
     924    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_bb   !Defines regions for SO2, BC & OM
     925    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_dust !Defines  dust regions
     926    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_wstardust !Defines  dust regions
     927    !$OMP THREADPRIVATE(iregion_so4,iregion_ind,iregion_bb,iregion_dust,iregion_wstardust)
     928
     929    !  Emissions:
     930
     931    !---------------------------- SEA SALT & DUST emissions ------------------------
     932    REAL lmt_sea_salt(klon, ss_bins) !Sea salt 0.03-8.0 um
     933    REAL u10m_ec1(klon), v10m_ec1(klon)
     934    REAL u10m_ec2(klon), v10m_ec2(klon), dust_ec2(klon)
     935    REAL dust_ec(klon)
     936    !     new dust emission chimere je20140522
     937    REAL, DIMENSION(klon), INTENT(IN) :: zu10m
     938    REAL, DIMENSION(klon), INTENT(IN) :: zv10m
     939    REAL, DIMENSION(klon), INTENT(IN) :: wstar, ale_bl, ale_wake
     940
     941    !  Rem : nbtr : nombre de vrais traceurs est defini dans dimphy.h
     942
     943    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     944    !Dynamique
     945    !--------
     946    REAL, DIMENSION(klon, klev, nbtr), INTENT(IN) :: d_tr_dyn
     947
     948    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     949    !  convection:
     950    !  -----------
     951
     952    REAL, intent(in) :: pmfu(klon, klev)  ! flux de masse dans le panache montant
     953    REAL, intent(in) :: pmfd(klon, klev)  ! flux de masse dans le panache descendant
     954    REAL, intent(in) :: pen_u(klon, klev) ! flux entraine dans le panache montant
     955    REAL, intent(in) :: pde_u(klon, klev) ! flux detraine dans le panache montant
     956    REAL, intent(in) :: pen_d(klon, klev) ! flux entraine dans le panache descendant
     957    REAL, intent(in) :: pde_d(klon, klev) ! flux detraine dans le panache descendant
     958
     959    !  Convection KE scheme:
     960    !  ---------------------
     961
     962    !! Variables pour le lessivage convectif
     963    REAL, DIMENSION(klon, klev), INTENT(IN) :: da
     964    REAL, DIMENSION(klon, klev, klev), INTENT(IN) :: phi
     965    REAL, DIMENSION(klon, klev, klev), INTENT(IN) :: phi2
     966    REAL, DIMENSION(klon, klev), INTENT(IN) :: d1a, dam
     967    REAL, DIMENSION(klon, klev), INTENT(IN) :: mp
     968    REAL, DIMENSION(klon, klev), INTENT(IN) :: upwd      ! saturated
     969    !            updraft mass flux
     970    REAL, DIMENSION(klon, klev), INTENT(IN) :: dnwd      ! saturated
     971    !            downdraft mass flux
     972    INTEGER, DIMENSION(klon), INTENT(IN) :: itop_con
     973    INTEGER, DIMENSION(klon), INTENT(IN) :: ibas_con
     974    REAL, DIMENSION(klon, klev) :: evapls
     975    REAL, DIMENSION(klon, klev), INTENT(IN) :: wdtrainA
     976    REAL, DIMENSION(klon, klev), INTENT(IN) :: wdtrainM
     977
     978    REAL, DIMENSION(klon, klev), INTENT(IN) :: ep
     979    REAL, DIMENSION(klon), INTENT(IN) :: sigd
     980    REAL, DIMENSION(klon, klev, klev), INTENT(IN) :: sij
     981    REAL, DIMENSION(klon, klev), INTENT(IN) :: clw
     982    REAL, DIMENSION(klon, klev, klev), INTENT(IN) :: elij
     983    REAL, DIMENSION(klon, klev, klev), INTENT(IN) :: epmlmMm
     984    REAL, DIMENSION(klon, klev), INTENT(IN) :: eplaMm
     985    REAL, DIMENSION(klon, klev), INTENT(IN) :: wght_cvfd          !RL
     986
     987
     988    !     KE: Tendances de traceurs (Td) et flux de traceurs:
     989    !     ------------------------
     990    REAL, DIMENSION(klon, klev) :: Mint
     991    REAL, DIMENSION(klon, klev, nbtr) :: zmfd1a
     992    REAL, DIMENSION(klon, klev, nbtr) :: zmfdam
     993    REAL, DIMENSION(klon, klev, nbtr) :: zmfphi2
     994
     995    !                                                        !tra dans pluie LS a la surf.
     996    !      outputs for cvltr_spl
     997    REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_cv_o
     998    REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_trsp_o
     999    REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_sscav_o
     1000    REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_sat_o
     1001    REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_uscav_o
     1002    !!!!!!!!!!!!!!!!!
     1003    !!!!!!!!!!!!!!!!!
     1004    !!!!!!!!!!!!!!!!!
     1005    REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_insc_o
     1006    REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_bcscav_o
     1007    REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_evapls_o
     1008    REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_ls_o
     1009    REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_dyn_o
     1010    REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_cl_o
     1011    REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_th_o
     1012    !!!!!!!!!!!!!!!!!
     1013    !!!!!!!!!!!!!!!!!
     1014    !!!!!!!!!!!!!!!!!
     1015
     1016    !$OMP THREADPRIVATE(d_tr_cv_o,d_tr_trsp_o,d_tr_sscav_o,d_tr_sat_o,d_tr_uscav_o)
     1017    !$OMP THREADPRIVATE(d_tr_insc_o,d_tr_bcscav_o,d_tr_evapls_o,d_tr_ls_o)
     1018    !$OMP THREADPRIVATE(d_tr_dyn_o,d_tr_cl_o,d_tr_th_o)
     1019
     1020    INTEGER :: nsplit
     1021
     1022    !  Lessivage
     1023    !  ---------
     1024
     1025    REAL, intent(in) :: pmflxr(klon, klev + 1), pmflxs(klon, klev + 1)   !--convection
     1026    REAL, intent(in) :: prfl(klon, klev + 1), psfl(klon, klev + 1)     !--large-scale
     1027    REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb
     1028    REAL :: ql_incloud_ref    ! ref value of in-cloud condensed water content
     1029
     1030    REAL, DIMENSION(klon, klev), INTENT(IN) :: rneb    ! fraction nuageuse (grande echelle)
     1031
     1032    REAL, DIMENSION(klon, klev) :: beta_fisrt ! taux de conversion
     1033    !                                                          ! de l'eau cond (de fisrtilp)
     1034    REAL, DIMENSION(klon, klev) :: beta_v1    ! -- (originale version)
     1035    INTEGER, SAVE :: iflag_lscav_omp, iflag_lscav
     1036    !$OMP THREADPRIVATE(iflag_lscav_omp,iflag_lscav)
     1037
     1038
     1039
     1040
     1041    !Thermiques:
     1042    !----------
     1043    REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: fm_therm
     1044    REAL, DIMENSION(klon, klev), INTENT(INOUT) :: entr_therm
     1045
     1046    !  Couche limite:
     1047    !  --------------
     1048
     1049    REAL, intent(in) :: coefh(klon, klev) ! coeff melange CL
     1050    REAL, intent(in) :: cdragh(klon), cdragm(klon)
     1051    REAL, intent(in) :: yu1(klon)        ! vent dans la 1iere couche
     1052    REAL, intent(in) :: yv1(klon)        ! vent dans la 1iere couche
     1053
     1054
     1055    !----------------------------------------------------------------------
     1056    REAL his_ds(klon, nbtr)
     1057    REAL his_dh(klon, nbtr)
     1058    REAL his_dhlsc(klon, nbtr)        ! in-cloud scavenging lsc
     1059    REAL his_dhcon(klon, nbtr)       ! in-cloud scavenging con
     1060    REAL his_dhbclsc(klon, nbtr)      ! below-cloud scavenging lsc
     1061    REAL his_dhbccon(klon, nbtr)      ! below-cloud scavenging con
     1062    REAL trm(klon, nbtr)
     1063
     1064    REAL u10m_ec(klon), v10m_ec(klon)
     1065
     1066    REAL his_th(klon, nbtr)
     1067    REAL his_dhkecv(klon, nbtr)
     1068    REAL his_dhkelsc(klon, nbtr)
     1069
     1070    !  Coordonnees
     1071    !  -----------
     1072
     1073    REAL, intent(in) :: rlat(klon)       ! latitudes pour chaque point
     1074    REAL, intent(in) :: rlon(klon)       ! longitudes pour chaque point
     1075
     1076    INTEGER i, k, iq, itr, j, ig
     1077
     1078    ! DEFINITION OF DIAGNOSTIC VARIABLES
     1079
     1080    REAL diag_trm(nbtr), diag_drydep(nbtr)
     1081    REAL diag_wetdep(nbtr), diag_cvtdep(nbtr)
     1082    REAL diag_emissn(nbtr), diag_g2part
     1083    REAL diag_sedimt
     1084    REAL trm_aux(nbtr), src_aux(nbtr)
     1085
     1086    ! Variables locales pour effectuer les appels en serie
     1087    !----------------------------------------------------
     1088    REAL source_tr(klon, nbtr)
     1089    REAL flux_tr(klon, nbtr)
     1090    REAL m_conc(klon, klev)
     1091    REAL henry(nbtr)  !--cste de Henry  mol/l/atm
     1092    REAL kk(nbtr)     !--coefficient de var avec T (K)
     1093    REAL alpha_r(nbtr)!--coefficient d'impaction pour la pluie
     1094    REAL alpha_s(nbtr)!--coefficient d'impaction pour la neige
     1095    REAL vdep_oce(nbtr), vdep_sic(nbtr)
     1096    REAL vdep_ter(nbtr), vdep_lic(nbtr)
     1097    REAL ccntrAA_spla(nbtr)
     1098    REAL ccntrENV_spla(nbtr)
     1099    REAL coefcoli_spla(nbtr)
     1100    REAL dtrconv(klon, nbtr)
     1101    REAL zrho(klon, klev), zdz(klon, klev)
     1102    REAL zalt(klon, klev)
     1103    REAL, DIMENSION(klon, klev) :: zmasse    ! densité atmosphérique
     1104    !     .                                              Kg/m2
     1105    REAL, DIMENSION(klon, klev) :: ztra_th
     1106    REAL qmin, qmax, aux
     1107    !      PARAMETER (qmin=0.0, qmax=1.e33)
     1108    PARAMETER (qmin = 1.e33, qmax = -1.e33)
     1109
     1110    ! Variables to save data into file
     1111    !----------------------------------
     1112
     1113    CHARACTER*2 str2
     1114    !!AS:      LOGICAL ok_histrac
     1115    !!!JE2014124      PARAMETER (ok_histrac=.true.)
     1116    !!      PARAMETER (ok_histrac=.false.)
     1117    INTEGER ndex2d(iim * (jjm + 1)), ndex3d(iim * (jjm + 1) * klev)
     1118    INTEGER nhori1, nhori2, nhori3, nhori4, nhori5, nvert
     1119    INTEGER nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5
     1120    SAVE nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5
     1121    !$OMP THREADPRIVATE(nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5)
     1122    INTEGER itra
     1123    SAVE itra                    ! compteur pour la physique
     1124    !$OMP THREADPRIVATE(itra)
     1125    INTEGER ecrit_tra, ecrit_tra_h, ecrit_tra_m
     1126    SAVE ecrit_tra, ecrit_tra_h, ecrit_tra_m
     1127    !$OMP THREADPRIVATE(ecrit_tra, ecrit_tra_h, ecrit_tra_m)
     1128    REAL presnivs(klev) ! pressions approximat. des milieux couches ( en PA)
     1129    REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, klev)
     1130    REAL zx_tmp_fi2d(klon), zx_tmp_fi3d(klon, klev)
     1131    REAL zx_lon_glo(nbp_lon, nbp_lat), zx_lat_glo(nbp_lon, nbp_lat)
     1132    REAL zsto, zout, zout_h, zout_m, zjulian
     1133
     1134    !------Molar Masses
     1135    REAL masse(nbtr)
     1136
     1137    REAL fracso2emis                              !--fraction so2 emis en so2
     1138    PARAMETER (fracso2emis = 0.95)
     1139    REAL frach2sofso2                             !--fraction h2s from so2
     1140    PARAMETER (frach2sofso2 = 0.0426)
     1141
     1142    !  Controles
     1143    !-------------
     1144    LOGICAL convection, lessivage, lminmax, lcheckmass
     1145    DATA convection, lessivage, lminmax, lcheckmass &
     1146            /.true., .true., .true., .false./
     1147
     1148    REAL xconv(nbtr)
     1149
     1150    LOGICAL anthropo, bateau, edgar
     1151    DATA anthropo, bateau, edgar/.true., .true., .true./
     1152
     1153    !c bc_source
     1154    INTEGER kminbc, kmaxbc
     1155    !JE20150715      PARAMETER (kminbc=3, kmaxbc=5)
     1156    PARAMETER (kminbc = 4, kmaxbc = 7)
     1157
     1158    REAL tr1_cont, tr2_cont, tr3_cont, tr4_cont
     1159
     1160    ! JE for updating in  cltrac
     1161    REAL, DIMENSION(klon, klev) :: delp     ! epaisseur de couche (Pa)
     1162    !! JE for include gas to particle conversion in output
     1163    !      REAL his_g2pgas(klon)      ! gastoparticle in gas units (check!)
     1164    !      REAL his_g2paer(klon)      ! gastoparticle in aerosol units (check!)
     1165
     1166    INTEGER, intent(in) :: iflag_conv
     1167    LOGICAL iscm3  ! debug variable. for checkmass ! JE
     1168
     1169    !------------------------------------------------------------------------
     1170    !  only to compute time consumption of each process
     1171    !----
     1172    INTEGER clock_start, clock_end, clock_rate, clock_start_spla
     1173    INTEGER clock_end_outphytracr, clock_start_outphytracr
     1174    INTEGER ti_init, dife, ti_inittype, ti_inittwrite
     1175    INTEGER ti_spla, ti_emis, ti_depo, ti_cltr, ti_ther
     1176    INTEGER ti_sedi, ti_gasp, ti_wetap, ti_cvltr, ti_lscs, ti_brop, ti_outs
     1177    INTEGER ti_nophytracr, clock_per_max
     1178    REAL tia_init, tia_inittype, tia_inittwrite
     1179    REAL tia_spla, tia_emis, tia_depo, tia_cltr, tia_ther
     1180    REAL tia_sedi, tia_gasp, tia_wetap, tia_cvltr, tia_lscs
     1181    REAL tia_brop, tia_outs
     1182    REAL tia_nophytracr
     1183
     1184    SAVE tia_init, tia_inittype, tia_inittwrite
     1185    SAVE tia_spla, tia_emis, tia_depo, tia_cltr, tia_ther
     1186    SAVE tia_sedi, tia_gasp, tia_wetap, tia_cvltr, tia_lscs
     1187    SAVE tia_brop, tia_outs
     1188    SAVE ti_nophytracr
     1189    SAVE tia_nophytracr
     1190    SAVE clock_end_outphytracr, clock_start_outphytracr
     1191    SAVE clock_per_max
     1192    LOGICAL logitime
     1193    !$OMP THREADPRIVATE(tia_init,tia_inittype,tia_inittwrite)
     1194    !$OMP THREADPRIVATE(tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther)
     1195    !$OMP THREADPRIVATE(tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs)
     1196    !$OMP THREADPRIVATE(tia_brop,tia_outs)
     1197    !$OMP THREADPRIVATE(ti_nophytracr)
     1198    !$OMP THREADPRIVATE(tia_nophytracr)
     1199    !$OMP THREADPRIVATE(clock_end_outphytracr,clock_start_outphytracr)
     1200    !$OMP THREADPRIVATE(clock_per_max)
     1201
     1202    !     utils parallelization
     1203    REAL :: auxklon_glo(klon_glo)
     1204    INTEGER :: iauxklon_glo(klon_glo)
     1205    REAL, DIMENSION(klon_glo, nbp_lev) :: auxklonnbp_lev
     1206    REAL, DIMENSION(klon_glo, nbp_lev, nbtr) :: auxklonklevnbtr_glo
     1207    REAL, DIMENSION(nbp_lon, nbp_lat) :: zx_tmp_2d_glo
     1208    REAL, DIMENSION(nbp_lon, nbp_lat, nbp_lev) :: zx_tmp_3d_glo
     1209    REAL, DIMENSION(klon_glo) :: zx_tmp_fi2d_glo
     1210    REAL, DIMENSION(klon_glo, nbp_lev) :: zx_tmp_fi3d_glo
     1211    REAL, DIMENSION(klon_glo, nbtr) :: auxklonnbtr_glo
     1212
     1213    source_tr = 0.
     1214
     1215    if (debutphy) then
    12521216#ifdef IOPHYS_DUST
    12531217         CALL iophys_ini(pdtphys)
    12541218#endif
    1255          nbreg_ind=1
    1256          nbreg_bb=1
    1257          nbreg_dust=1
    1258          nbreg_wstardust=1
    1259          CALL phytracr_spl_ini(klon,nbreg_ind,nbreg_bb,nbreg_dust,nbreg_wstardust)
    1260       endif
     1219      nbreg_ind = 1
     1220      nbreg_bb = 1
     1221      nbreg_dust = 1
     1222      nbreg_wstardust = 1
     1223      CALL phytracr_spl_ini(klon, nbreg_ind, nbreg_bb, nbreg_dust, nbreg_wstardust)
     1224    endif
    12611225
    12621226
    … …  
    12711235#endif
    12721236
    1273  
    1274 
    1275 
    1276   ijulday=jD_cur-jD_1jan+1
    1277   nbjour = 1
    1278 
    1279   paramname_ind='ind'
    1280   paramname_bb='bb'
    1281   paramname_ff='ind'
    1282   paramname_dustacc='dustacc'
    1283   paramname_dustcoa='dustcoasco'
    1284   paramname_dustsco='dustcoasco'
    1285 !  paramname_dustacc='dust'
    1286 !  paramname_dustcoa='dust'
    1287 !  paramname_dustsco='dust'
    1288   paramname_wstarBL='pwstarbl'
    1289   paramname_wstarWAKE='pwstarwake'
    1290   paramname_ssacc='ssacc'
    1291   paramname_sscoa='sscoa'
    1292 
    1293   filescaleparams='modvalues.nc'
    1294 !AS: debranchage de lecture des coefs d'assmilation de Jeronimo Escribano
    1295   IF("ASSIM"=="YES") THEN
    1296     CALL readscaleparamsnc_spl(scale_param_ind,                        &
    1297         nbreg_ind, paramname_ind,                                    &
    1298         scale_param_ff, nbreg_ind,paramname_ff,                      &
    1299         scale_param_bb, nbreg_bb,paramname_bb,                       &
    1300         scale_param_dustacc, nbreg_dust,paramname_dustacc,           &
    1301         scale_param_dustcoa, nbreg_dust,paramname_dustcoa,           &
    1302         scale_param_dustsco, nbreg_dust,paramname_dustsco,           &
    1303         param_wstarBLperregion, nbreg_wstardust, paramname_wstarBL, &
    1304         param_wstarWAKEperregion, nbreg_wstardust, paramname_wstarWAKE, &
    1305         scale_param_ssacc  ,  paramname_ssacc,                    &
    1306         scale_param_sscoa  ,  paramname_sscoa,                    &
    1307            filescaleparams,ijulday,jH_cur, pdtphys,debutphy)
    1308   ENDIF ! ASSIM
    1309 !AS: le commentaire suivant "add seasalt" ne semble pas avoir ete mis en pratique.
    1310 ! Des fichiers regions_ssacc et _sscoa existent mais ne semblent pas lus.
    1311 ! Ca reste donc aux valeurs initialisées: nbreg_ss=1, scale_param_ss*=1, cf fichiers ss et modvalues
    1312 !! add seasalt
    1313 
    1314   print *,'JE : check scale_params'
    1315 
    1316   print *, 'nbreg_ind', nbreg_ind   
    1317   print *, 'nbreg_dust', nbreg_dust 
    1318   print *, 'nbreg_bb', nbreg_bb   
    1319   print *, 'ind', scale_param_ind   
    1320   print *, 'dustacc', scale_param_dustacc 
    1321   print *, 'dustcoa', scale_param_dustcoa 
    1322   print *, 'dustsco', scale_param_dustsco
    1323   print *, 'wstardustBL', param_wstarBLperregion
    1324   print *, 'wstardustWAKE', param_wstarWAKEperregion
    1325   print *, 'ff', scale_param_ff 
    1326   print *, 'bb', scale_param_bb 
    1327   print *, 'ssacc', scale_param_ssacc
    1328   print *, 'sscoa', scale_param_sscoa
    1329 
    1330   print *,'JE: before read_newemissions '
    1331   print *,'JE: jD_cur:',jD_cur,' ijulday:',ijulday,' jH_cur:',jH_cur,' pdtphys:',pdtphys
    1332   print *,'JE: now read_newemissions:'
    1333 !AS: La ligne suivante fait planter a l'execution : lmt_so2ff_l pas initialise
    1334 !  print *,'lmt_so2ff_l AVANT' , MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
    1335   call read_newemissions(ijulday,jH_cur ,edgar, flag_dms,debutphy, & !I
    1336                          pdtphys, lafin, nbjour, pctsrf,  &       !I
    1337                          t_seri, rlat, rlon, &                         !I
    1338                          pmflxr, pmflxs, prfl, psfl, &            !I
    1339                                  u10m_ec, v10m_ec, dust_ec, &     !O
    1340                                  lmt_sea_salt, lmt_so2ff_l, &     !O
    1341                                  lmt_so2ff_h, lmt_so2nff, &       !O
    1342                                  lmt_so2ba, lmt_so2bb_l, lmt_so2bb_h, &  !O
    1343                                  lmt_so2volc_cont, lmt_altvolc_cont, &   !O
    1344                                  lmt_so2volc_expl, lmt_altvolc_expl, &   !O
    1345                                  lmt_dmsbio, lmt_h2sbio, lmt_dmsconc, &  !O
    1346                                  lmt_bcff, lmt_bcnff, lmt_bcbb_l, &      !O
    1347                                  lmt_bcbb_h, lmt_bcba, lmt_omff, &       !O
    1348                                  lmt_omnff, lmt_ombb_l, lmt_ombb_h, &    !O
    1349                                  lmt_omnat, lmt_omba)                    !O
    1350 
    1351 
    1352   print *,'Check emissions'
    1353   print *,'lmt_so2ff_l' , MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
    1354   print *,'lmt_so2ff_h' , MINVAL(lmt_so2ff_h), MAXVAL(lmt_so2ff_h)
    1355   print *,'lmt_so2nff' , MINVAL(lmt_so2nff), MAXVAL(lmt_so2nff)
    1356   print *,'lmt_so2ba' , MINVAL(lmt_so2ba), MAXVAL(lmt_so2ba)
    1357   print *,'lmt_so2bb_l' , MINVAL(lmt_so2bb_l), MAXVAL(lmt_so2bb_l)
    1358   print *,'lmt_so2bb_h' , MINVAL(lmt_so2bb_h), MAXVAL(lmt_so2bb_h)
    1359   print *,'lmt_so2volc_cont' , MINVAL(lmt_so2volc_cont), MAXVAL(lmt_so2volc_cont)
    1360   print *,'lmt_altvolc_cont' , MINVAL(lmt_altvolc_cont), MAXVAL(lmt_altvolc_cont)
    1361   print *,'lmt_so2volc_expl' , MINVAL(lmt_so2volc_expl), MAXVAL(lmt_so2volc_expl)
    1362   print *,'lmt_altvolc_expl' , MINVAL(lmt_altvolc_expl), MAXVAL(lmt_altvolc_expl)
    1363   print *,'lmt_dmsbio' , MINVAL(lmt_dmsbio), MAXVAL(lmt_dmsbio)
    1364   print *,'lmt_h2sbio' , MINVAL(lmt_h2sbio), MAXVAL(lmt_h2sbio)
    1365   print *,'lmt_dmsconc' , MINVAL(lmt_dmsconc), MAXVAL(lmt_dmsconc)
    1366   print *,'lmt_bcff' , MINVAL(lmt_bcff), MAXVAL(lmt_bcff)
    1367   print *,'lmt_bcnff' , MINVAL(lmt_bcnff), MAXVAL(lmt_bcnff)
    1368   print *,'lmt_bcbb_l' , MINVAL(lmt_bcbb_l), MAXVAL(lmt_bcbb_l)
    1369   print *,'lmt_bcbb_h' , MINVAL(lmt_bcbb_h), MAXVAL(lmt_bcbb_h)
    1370   print *,'lmt_bcba' , MINVAL(lmt_bcba), MAXVAL(lmt_bcba)
    1371   print *,'lmt_omff' , MINVAL(lmt_omff), MAXVAL(lmt_omff)
    1372   print *,'lmt_omnff' , MINVAL(lmt_omnff), MAXVAL(lmt_omnff)
    1373   print *,'lmt_ombb_l' , MINVAL(lmt_ombb_l), MAXVAL(lmt_ombb_l)
    1374   print *,'lmt_ombb_h' , MINVAL(lmt_ombb_h), MAXVAL(lmt_ombb_h)
    1375   print *,'lmt_omnat' , MINVAL(lmt_omnat), MAXVAL(lmt_omnat)
    1376   print *,'lmt_omba' , MINVAL(lmt_omba), MAXVAL(lmt_omba)
    1377   print *,'JE iflag_con',iflag_conv
    1378 
    1379 
    1380 !JE_dbg
    1381    do i=1,klon
    1382       tsol(i)=0.0
    1383       do j=1,nbsrf
    1384           tsol(i)=tsol(i)+ftsol(i,j)*pctsrf(i,j)
     1237
     1238
     1239
     1240    ijulday = jD_cur - jD_1jan + 1
     1241    nbjour = 1
     1242
     1243    paramname_ind = 'ind'
     1244    paramname_bb = 'bb'
     1245    paramname_ff = 'ind'
     1246    paramname_dustacc = 'dustacc'
     1247    paramname_dustcoa = 'dustcoasco'
     1248    paramname_dustsco = 'dustcoasco'
     1249    !  paramname_dustacc='dust'
     1250    !  paramname_dustcoa='dust'
     1251    !  paramname_dustsco='dust'
     1252    paramname_wstarBL = 'pwstarbl'
     1253    paramname_wstarWAKE = 'pwstarwake'
     1254    paramname_ssacc = 'ssacc'
     1255    paramname_sscoa = 'sscoa'
     1256
     1257    filescaleparams = 'modvalues.nc'
     1258    !AS: debranchage de lecture des coefs d'assmilation de Jeronimo Escribano
     1259    IF("ASSIM"=="YES") THEN
     1260      CALL readscaleparamsnc_spl(scale_param_ind, &
     1261              nbreg_ind, paramname_ind, &
     1262              scale_param_ff, nbreg_ind, paramname_ff, &
     1263              scale_param_bb, nbreg_bb, paramname_bb, &
     1264              scale_param_dustacc, nbreg_dust, paramname_dustacc, &
     1265              scale_param_dustcoa, nbreg_dust, paramname_dustcoa, &
     1266              scale_param_dustsco, nbreg_dust, paramname_dustsco, &
     1267              param_wstarBLperregion, nbreg_wstardust, paramname_wstarBL, &
     1268              param_wstarWAKEperregion, nbreg_wstardust, paramname_wstarWAKE, &
     1269              scale_param_ssacc, paramname_ssacc, &
     1270              scale_param_sscoa, paramname_sscoa, &
     1271              filescaleparams, ijulday, jH_cur, pdtphys, debutphy)
     1272    ENDIF ! ASSIM
     1273    !AS: le commentaire suivant "add seasalt" ne semble pas avoir ete mis en pratique.
     1274    ! Des fichiers regions_ssacc et _sscoa existent mais ne semblent pas lus.
     1275    ! Ca reste donc aux valeurs initialisées: nbreg_ss=1, scale_param_ss*=1, cf fichiers ss et modvalues
     1276    !! add seasalt
     1277
     1278    print *, 'JE : check scale_params'
     1279
     1280    print *, 'nbreg_ind', nbreg_ind
     1281    print *, 'nbreg_dust', nbreg_dust
     1282    print *, 'nbreg_bb', nbreg_bb
     1283    print *, 'ind', scale_param_ind
     1284    print *, 'dustacc', scale_param_dustacc
     1285    print *, 'dustcoa', scale_param_dustcoa
     1286    print *, 'dustsco', scale_param_dustsco
     1287    print *, 'wstardustBL', param_wstarBLperregion
     1288    print *, 'wstardustWAKE', param_wstarWAKEperregion
     1289    print *, 'ff', scale_param_ff
     1290    print *, 'bb', scale_param_bb
     1291    print *, 'ssacc', scale_param_ssacc
     1292    print *, 'sscoa', scale_param_sscoa
     1293
     1294    print *, 'JE: before read_newemissions '
     1295    print *, 'JE: jD_cur:', jD_cur, ' ijulday:', ijulday, ' jH_cur:', jH_cur, ' pdtphys:', pdtphys
     1296    print *, 'JE: now read_newemissions:'
     1297    !AS: La ligne suivante fait planter a l'execution : lmt_so2ff_l pas initialise
     1298    !  print *,'lmt_so2ff_l AVANT' , MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
     1299    call read_newemissions(ijulday, jH_cur, edgar, flag_dms, debutphy, & !I
     1300            pdtphys, lafin, nbjour, pctsrf, &       !I
     1301            t_seri, rlat, rlon, &                         !I
     1302            pmflxr, pmflxs, prfl, psfl, &            !I
     1303            u10m_ec, v10m_ec, dust_ec, &     !O
     1304            lmt_sea_salt, lmt_so2ff_l, &     !O
     1305            lmt_so2ff_h, lmt_so2nff, &       !O
     1306            lmt_so2ba, lmt_so2bb_l, lmt_so2bb_h, &  !O
     1307            lmt_so2volc_cont, lmt_altvolc_cont, &   !O
     1308            lmt_so2volc_expl, lmt_altvolc_expl, &   !O
     1309            lmt_dmsbio, lmt_h2sbio, lmt_dmsconc, &  !O
     1310            lmt_bcff, lmt_bcnff, lmt_bcbb_l, &      !O
     1311            lmt_bcbb_h, lmt_bcba, lmt_omff, &       !O
     1312            lmt_omnff, lmt_ombb_l, lmt_ombb_h, &    !O
     1313            lmt_omnat, lmt_omba)                    !O
     1314
     1315    print *, 'Check emissions'
     1316    print *, 'lmt_so2ff_l', MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
     1317    print *, 'lmt_so2ff_h', MINVAL(lmt_so2ff_h), MAXVAL(lmt_so2ff_h)
     1318    print *, 'lmt_so2nff', MINVAL(lmt_so2nff), MAXVAL(lmt_so2nff)
     1319    print *, 'lmt_so2ba', MINVAL(lmt_so2ba), MAXVAL(lmt_so2ba)
     1320    print *, 'lmt_so2bb_l', MINVAL(lmt_so2bb_l), MAXVAL(lmt_so2bb_l)
     1321    print *, 'lmt_so2bb_h', MINVAL(lmt_so2bb_h), MAXVAL(lmt_so2bb_h)
     1322    print *, 'lmt_so2volc_cont', MINVAL(lmt_so2volc_cont), MAXVAL(lmt_so2volc_cont)
     1323    print *, 'lmt_altvolc_cont', MINVAL(lmt_altvolc_cont), MAXVAL(lmt_altvolc_cont)
     1324    print *, 'lmt_so2volc_expl', MINVAL(lmt_so2volc_expl), MAXVAL(lmt_so2volc_expl)
     1325    print *, 'lmt_altvolc_expl', MINVAL(lmt_altvolc_expl), MAXVAL(lmt_altvolc_expl)
     1326    print *, 'lmt_dmsbio', MINVAL(lmt_dmsbio), MAXVAL(lmt_dmsbio)
     1327    print *, 'lmt_h2sbio', MINVAL(lmt_h2sbio), MAXVAL(lmt_h2sbio)
     1328    print *, 'lmt_dmsconc', MINVAL(lmt_dmsconc), MAXVAL(lmt_dmsconc)
     1329    print *, 'lmt_bcff', MINVAL(lmt_bcff), MAXVAL(lmt_bcff)
     1330    print *, 'lmt_bcnff', MINVAL(lmt_bcnff), MAXVAL(lmt_bcnff)
     1331    print *, 'lmt_bcbb_l', MINVAL(lmt_bcbb_l), MAXVAL(lmt_bcbb_l)
     1332    print *, 'lmt_bcbb_h', MINVAL(lmt_bcbb_h), MAXVAL(lmt_bcbb_h)
     1333    print *, 'lmt_bcba', MINVAL(lmt_bcba), MAXVAL(lmt_bcba)
     1334    print *, 'lmt_omff', MINVAL(lmt_omff), MAXVAL(lmt_omff)
     1335    print *, 'lmt_omnff', MINVAL(lmt_omnff), MAXVAL(lmt_omnff)
     1336    print *, 'lmt_ombb_l', MINVAL(lmt_ombb_l), MAXVAL(lmt_ombb_l)
     1337    print *, 'lmt_ombb_h', MINVAL(lmt_ombb_h), MAXVAL(lmt_ombb_h)
     1338    print *, 'lmt_omnat', MINVAL(lmt_omnat), MAXVAL(lmt_omnat)
     1339    print *, 'lmt_omba', MINVAL(lmt_omba), MAXVAL(lmt_omba)
     1340    print *, 'JE iflag_con', iflag_conv
     1341
     1342
     1343    !JE_dbg
     1344    do i = 1, klon
     1345      tsol(i) = 0.0
     1346      do j = 1, nbsrf
     1347        tsol(i) = tsol(i) + ftsol(i, j) * pctsrf(i, j)
    13851348      enddo
    1386    enddo
    1387 
    1388 
    1389 !======================================================================
    1390 !  INITIALISATIONS
    1391 !======================================================================
    1392 !             CALL checknanqfi(da(:,:),1.,-1.,' da_ before
    1393 !     . phytracr_inphytracr')
    1394 
    1395 !
    1396 ! computing time
    1397 !        logitime=.true.
    1398         logitime=.false.
    1399         IF (logitime) THEN
    1400         clock_start=0
    1401         clock_end=0
    1402         clock_rate=0
    1403        CALL SYSTEM_CLOCK(COUNT_RATE=clock_rate,COUNT_MAX=clock_per_max)
    1404         CALL SYSTEM_CLOCK(COUNT=clock_start_spla)
    1405         clock_start=clock_start_spla
    1406         clock_end_outphytracr=clock_start_spla
    1407         ENDIF
    1408 
    1409 
    1410 ! Definition of tracers index.
    1411       print*,'OK ON PASSSE BIEN LA'
    1412       CALL minmaxsource(source_tr,qmin,qmax,'A1 maxsource init phytracr')
    1413 
    1414 
    1415       IF (debutphy) THEN
    1416         id_prec=-1
    1417         id_fine=-1
    1418         id_coss=-1
    1419         id_codu=-1
    1420         id_scdu=-1
    1421         itr = 0
    1422         do iq=1,nqtot
    1423           IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    1424           itr = itr+1
    1425           print *, itr, TRIM(tracers(iq)%name)
    1426           SELECT CASE(tracers(iq)%name)
    1427             CASE('PREC'); id_prec=itr
    1428             CASE('FINE'); id_fine=itr
    1429             CASE('COSS'); id_coss=itr
    1430             CASE('CODU'); id_codu=itr
    1431             CASE('SCDU'); id_scdu=itr
    1432           END SELECT
    1433         enddo
    1434         ! check consistency with dust emission scheme:
    1435         if (ok_chimeredust) then
    1436           if (.not.( id_scdu>0 .and. id_codu>0 .and. id_fine>0)) then
    1437              call abort_gcm('phytracr_mod', 'pb in ok_chimdust 0',1)
    1438           endif
    1439         else
    1440           if (id_scdu>0) then
    1441        call abort_gcm('phytracr_mod', 'pb in ok_chimdust 1 SCDU',1)
    1442           endif
    1443           if ( (id_codu <= 0) .or. ( id_fine<=0)  ) then
    1444           call abort_gcm('phytracr_mod', 'pb in ok_chimdust 1',1)
    1445           endif
    1446        endif
    1447 
    1448 
    1449        !print *,id_prec,id_fine,id_coss,id_codu,id_scdu
    1450        ENDIF
    1451 
    1452 
    1453 
    1454 
    1455 
    1456 
    1457 !---fraction of tracer that is convected (Tiedke)
    1458       xconv(:)=0.
    1459       if(id_prec>0)  xconv(id_prec)=0.8
    1460       if(id_fine>0)  xconv(id_fine)=0.5
    1461       if(id_coss>0)  xconv(id_coss)=0.5
    1462       if(id_codu>0)  xconv(id_codu)=0.6
    1463       if(id_scdu>0)  xconv(id_scdu)=0.6  !!JE fix
    1464 
    1465       masse(:)=1.
    1466       if(id_prec>0)  masse(id_prec)=32.
    1467       if(id_fine>0)  masse(id_fine)=6.02e23
    1468       if(id_coss>0)  masse(id_coss)=6.02e23
    1469       if(id_codu>0)  masse(id_codu)=6.02e23
    1470       if(id_scdu>0)  masse(id_scdu)=6.02e23
    1471 
    1472       henry(:)=0.
    1473       if(id_prec>0)  henry(id_prec)=1.4
    1474       if(id_fine>0)  henry(id_fine)=0.0
    1475       if(id_coss>0)  henry(id_coss)=0.0
    1476       if(id_codu>0)  henry(id_codu)=0.0
    1477       if(id_scdu>0)  henry(id_scdu)=0.0
    1478       !henry= (/1.4, 0.0, 0.0, 0.0/)
    1479       kk(:)=0.
    1480       if(id_prec>0)  kk(id_prec)=2900.
    1481       if(id_fine>0)  kk(id_fine)=0.0
    1482       if(id_coss>0)  kk(id_coss)=0.0
    1483       if(id_codu>0)  kk(id_codu)=0.0
    1484       if(id_scdu>0)  kk(id_scdu)=0.0
    1485       !kk = (/2900., 0., 0., 0./)
    1486       alpha_r(:)=0.
    1487       if(id_prec>0)  alpha_r(id_prec)=0.0
    1488       if(id_fine>0)  alpha_r(id_fine)=0.001
    1489       if(id_coss>0)  alpha_r(id_coss)=0.001
    1490       if(id_codu>0)  alpha_r(id_codu)=0.001
    1491       if(id_scdu>0)  alpha_r(id_scdu)=0.001  !JE fix
    1492       alpha_s(:)=0.
    1493       if(id_prec>0)  alpha_s(id_prec)=0.0
    1494       if(id_fine>0)  alpha_s(id_fine)=0.01
    1495       if(id_coss>0)  alpha_s(id_coss)=0.01
    1496       if(id_codu>0)  alpha_s(id_codu)=0.01
    1497       if(id_scdu>0)  alpha_s(id_scdu)=0.01  !JE fix
    1498 
    1499 !      alpha_r =  (/0., 0.001, 0.001, 0.001/)
    1500 !      alpha_s = (/0., 0.01, 0.01, 0.01/)
    1501 
    1502 ! nhl      DATA vdep_oce /0.7, 0.05, 1.2, 1.2/
    1503 ! nhl vdep_oce for tr1 is a weighted average of dms and so2 dep velocities
    1504       !vdep_oce = (/0.28, 0.28, 1.2, 1.2/)
    1505       vdep_oce(:)=0.
    1506       if(id_prec>0)  vdep_oce(id_prec) = 0.28
    1507       if(id_fine>0)  vdep_oce(id_fine) = 0.28
    1508       if(id_coss>0)  vdep_oce(id_coss) = 1.2
    1509       if(id_codu>0)  vdep_oce(id_codu) = 1.2
    1510       if(id_scdu>0)  vdep_oce(id_scdu) = 1.2
    1511       vdep_sic(:)=0.
    1512       if(id_prec>0)  vdep_sic(id_prec) = 0.2
    1513       if(id_fine>0)  vdep_sic(id_fine) = 0.17
    1514       if(id_coss>0)  vdep_sic(id_coss) = 1.2
    1515       if(id_codu>0)  vdep_sic(id_codu) = 1.2
    1516       if(id_scdu>0)  vdep_sic(id_scdu) = 1.2
    1517 
    1518       !vdep_sic = (/0.2, 0.17, 1.2, 1.2/)     
    1519       !vdep_ter = (/0.3, 0.14, 1.2, 1.2/)
    1520       vdep_ter(:)=0.
    1521       if(id_prec>0)  vdep_ter(id_prec) = 0.3
    1522       if(id_fine>0)  vdep_ter(id_fine) = 0.14
    1523       if(id_coss>0)  vdep_ter(id_coss) = 1.2
    1524       if(id_codu>0)  vdep_ter(id_codu) = 1.2
    1525       if(id_scdu>0)  vdep_ter(id_scdu) = 1.2
    1526 
    1527       vdep_lic(:)=0.
    1528       if(id_prec>0)  vdep_lic(id_prec) = 0.2
    1529       if(id_fine>0)  vdep_lic(id_fine) = 0.17
    1530       if(id_coss>0)  vdep_lic(id_coss) = 1.2
    1531       if(id_codu>0)  vdep_lic(id_codu) = 1.2
    1532       if(id_scdu>0)  vdep_lic(id_scdu) = 1.2
    1533 
    1534 
    1535       ! convective KE lessivage aer params:
    1536       ! AS: #DFB (Binta) a aussi teste ccntrAA_spla=ccntrENV_spla=0.9/1.0/0.9/0.9
    1537       !     mais effet negligeable sur l'AOD
    1538       ccntrAA_spla(:)=0.
    1539       if(id_prec>0)  ccntrAA_spla(id_prec)=-9999.
    1540       if(id_fine>0)  ccntrAA_spla(id_fine)=0.7
    1541       if(id_coss>0)  ccntrAA_spla(id_coss)=1.0
    1542       if(id_codu>0)  ccntrAA_spla(id_codu)=0.7
    1543       if(id_scdu>0)  ccntrAA_spla(id_scdu)=0.7
    1544 
    1545       ccntrENV_spla(:)=0.
    1546       if(id_prec>0)  ccntrENV_spla(id_prec)=-9999.
    1547       if(id_fine>0)  ccntrENV_spla(id_fine)=0.7
    1548       if(id_coss>0)  ccntrENV_spla(id_coss)=1.0
    1549       if(id_codu>0)  ccntrENV_spla(id_codu)=0.7
    1550       if(id_scdu>0)  ccntrENV_spla(id_scdu)=0.7
    1551       ! #DFB
    1552       coefcoli_spla(:)=0.
    1553       if(id_prec>0)  coefcoli_spla(id_prec)=-9999.
    1554       if(id_fine>0)  coefcoli_spla(id_fine)=0.001
    1555       if(id_coss>0)  coefcoli_spla(id_coss)=0.001
    1556       if(id_codu>0)  coefcoli_spla(id_codu)=0.001
    1557       if(id_scdu>0)  coefcoli_spla(id_scdu)=0.001
    1558 
    1559       !vdep_lic = (/0.2, 0.17, 1.2, 1.2/)     
    1560 !
    1561 
    1562       iscm3=.false.
    1563       if (debutphy) then
    1564 !$OMP MASTER
    1565          CALL suphel
    1566          print *, 'let s check nbtr=', nbtr
    1567 ! JE before put in zero
     1349    enddo
     1350
     1351
     1352    !======================================================================
     1353    !  INITIALISATIONS
     1354    !======================================================================
     1355    !             CALL checknanqfi(da(:,:),1.,-1.,' da_ before
     1356    !     . phytracr_inphytracr')
     1357
     1358    ! computing time
     1359    !        logitime=.true.
     1360    logitime = .false.
     1361    IF (logitime) THEN
     1362      clock_start = 0
     1363      clock_end = 0
     1364      clock_rate = 0
     1365      CALL SYSTEM_CLOCK(COUNT_RATE = clock_rate, COUNT_MAX = clock_per_max)
     1366      CALL SYSTEM_CLOCK(COUNT = clock_start_spla)
     1367      clock_start = clock_start_spla
     1368      clock_end_outphytracr = clock_start_spla
     1369    ENDIF
     1370
     1371
     1372    ! Definition of tracers index.
     1373    print*, 'OK ON PASSSE BIEN LA'
     1374    CALL minmaxsource(source_tr, qmin, qmax, 'A1 maxsource init phytracr')
     1375
     1376    IF (debutphy) THEN
     1377      id_prec = -1
     1378      id_fine = -1
     1379      id_coss = -1
     1380      id_codu = -1
     1381      id_scdu = -1
     1382      itr = 0
     1383      do iq = 1, nqtot
     1384        IF(.NOT.tracers(iq)%isInPhysics) CYCLE
     1385        itr = itr + 1
     1386        print *, itr, TRIM(tracers(iq)%name)
     1387        SELECT CASE(tracers(iq)%name)
     1388        CASE('PREC'); id_prec = itr
     1389        CASE('FINE'); id_fine = itr
     1390        CASE('COSS'); id_coss = itr
     1391        CASE('CODU'); id_codu = itr
     1392        CASE('SCDU'); id_scdu = itr
     1393        END SELECT
     1394      enddo
     1395      ! check consistency with dust emission scheme:
     1396      if (ok_chimeredust) then
     1397        if (.not.(id_scdu>0 .and. id_codu>0 .and. id_fine>0)) then
     1398          call abort_gcm('phytracr_mod', 'pb in ok_chimdust 0', 1)
     1399        endif
     1400      else
     1401        if (id_scdu>0) then
     1402          call abort_gcm('phytracr_mod', 'pb in ok_chimdust 1 SCDU', 1)
     1403        endif
     1404        if ((id_codu <= 0) .or. (id_fine<=0)) then
     1405          call abort_gcm('phytracr_mod', 'pb in ok_chimdust 1', 1)
     1406        endif
     1407      endif
     1408
     1409
     1410      !print *,id_prec,id_fine,id_coss,id_codu,id_scdu
     1411    ENDIF
     1412
     1413
     1414
     1415
     1416
     1417
     1418    !---fraction of tracer that is convected (Tiedke)
     1419    xconv(:) = 0.
     1420    if(id_prec>0)  xconv(id_prec) = 0.8
     1421    if(id_fine>0)  xconv(id_fine) = 0.5
     1422    if(id_coss>0)  xconv(id_coss) = 0.5
     1423    if(id_codu>0)  xconv(id_codu) = 0.6
     1424    if(id_scdu>0)  xconv(id_scdu) = 0.6  !!JE fix
     1425
     1426    masse(:) = 1.
     1427    if(id_prec>0)  masse(id_prec) = 32.
     1428    if(id_fine>0)  masse(id_fine) = 6.02e23
     1429    if(id_coss>0)  masse(id_coss) = 6.02e23
     1430    if(id_codu>0)  masse(id_codu) = 6.02e23
     1431    if(id_scdu>0)  masse(id_scdu) = 6.02e23
     1432
     1433    henry(:) = 0.
     1434    if(id_prec>0)  henry(id_prec) = 1.4
     1435    if(id_fine>0)  henry(id_fine) = 0.0
     1436    if(id_coss>0)  henry(id_coss) = 0.0
     1437    if(id_codu>0)  henry(id_codu) = 0.0
     1438    if(id_scdu>0)  henry(id_scdu) = 0.0
     1439    !henry= (/1.4, 0.0, 0.0, 0.0/)
     1440    kk(:) = 0.
     1441    if(id_prec>0)  kk(id_prec) = 2900.
     1442    if(id_fine>0)  kk(id_fine) = 0.0
     1443    if(id_coss>0)  kk(id_coss) = 0.0
     1444    if(id_codu>0)  kk(id_codu) = 0.0
     1445    if(id_scdu>0)  kk(id_scdu) = 0.0
     1446    !kk = (/2900., 0., 0., 0./)
     1447    alpha_r(:) = 0.
     1448    if(id_prec>0)  alpha_r(id_prec) = 0.0
     1449    if(id_fine>0)  alpha_r(id_fine) = 0.001
     1450    if(id_coss>0)  alpha_r(id_coss) = 0.001
     1451    if(id_codu>0)  alpha_r(id_codu) = 0.001
     1452    if(id_scdu>0)  alpha_r(id_scdu) = 0.001  !JE fix
     1453    alpha_s(:) = 0.
     1454    if(id_prec>0)  alpha_s(id_prec) = 0.0
     1455    if(id_fine>0)  alpha_s(id_fine) = 0.01
     1456    if(id_coss>0)  alpha_s(id_coss) = 0.01
     1457    if(id_codu>0)  alpha_s(id_codu) = 0.01
     1458    if(id_scdu>0)  alpha_s(id_scdu) = 0.01  !JE fix
     1459
     1460    !      alpha_r =  (/0., 0.001, 0.001, 0.001/)
     1461    !      alpha_s = (/0., 0.01, 0.01, 0.01/)
     1462
     1463    ! nhl      DATA vdep_oce /0.7, 0.05, 1.2, 1.2/
     1464    ! nhl vdep_oce for tr1 is a weighted average of dms and so2 dep velocities
     1465    !vdep_oce = (/0.28, 0.28, 1.2, 1.2/)
     1466    vdep_oce(:) = 0.
     1467    if(id_prec>0)  vdep_oce(id_prec) = 0.28
     1468    if(id_fine>0)  vdep_oce(id_fine) = 0.28
     1469    if(id_coss>0)  vdep_oce(id_coss) = 1.2
     1470    if(id_codu>0)  vdep_oce(id_codu) = 1.2
     1471    if(id_scdu>0)  vdep_oce(id_scdu) = 1.2
     1472    vdep_sic(:) = 0.
     1473    if(id_prec>0)  vdep_sic(id_prec) = 0.2
     1474    if(id_fine>0)  vdep_sic(id_fine) = 0.17
     1475    if(id_coss>0)  vdep_sic(id_coss) = 1.2
     1476    if(id_codu>0)  vdep_sic(id_codu) = 1.2
     1477    if(id_scdu>0)  vdep_sic(id_scdu) = 1.2
     1478
     1479    !vdep_sic = (/0.2, 0.17, 1.2, 1.2/)
     1480    !vdep_ter = (/0.3, 0.14, 1.2, 1.2/)
     1481    vdep_ter(:) = 0.
     1482    if(id_prec>0)  vdep_ter(id_prec) = 0.3
     1483    if(id_fine>0)  vdep_ter(id_fine) = 0.14
     1484    if(id_coss>0)  vdep_ter(id_coss) = 1.2
     1485    if(id_codu>0)  vdep_ter(id_codu) = 1.2
     1486    if(id_scdu>0)  vdep_ter(id_scdu) = 1.2
     1487
     1488    vdep_lic(:) = 0.
     1489    if(id_prec>0)  vdep_lic(id_prec) = 0.2
     1490    if(id_fine>0)  vdep_lic(id_fine) = 0.17
     1491    if(id_coss>0)  vdep_lic(id_coss) = 1.2
     1492    if(id_codu>0)  vdep_lic(id_codu) = 1.2
     1493    if(id_scdu>0)  vdep_lic(id_scdu) = 1.2
     1494
     1495
     1496    ! convective KE lessivage aer params:
     1497    ! AS: #DFB (Binta) a aussi teste ccntrAA_spla=ccntrENV_spla=0.9/1.0/0.9/0.9
     1498    !     mais effet negligeable sur l'AOD
     1499    ccntrAA_spla(:) = 0.
     1500    if(id_prec>0)  ccntrAA_spla(id_prec) = -9999.
     1501    if(id_fine>0)  ccntrAA_spla(id_fine) = 0.7
     1502    if(id_coss>0)  ccntrAA_spla(id_coss) = 1.0
     1503    if(id_codu>0)  ccntrAA_spla(id_codu) = 0.7
     1504    if(id_scdu>0)  ccntrAA_spla(id_scdu) = 0.7
     1505
     1506    ccntrENV_spla(:) = 0.
     1507    if(id_prec>0)  ccntrENV_spla(id_prec) = -9999.
     1508    if(id_fine>0)  ccntrENV_spla(id_fine) = 0.7
     1509    if(id_coss>0)  ccntrENV_spla(id_coss) = 1.0
     1510    if(id_codu>0)  ccntrENV_spla(id_codu) = 0.7
     1511    if(id_scdu>0)  ccntrENV_spla(id_scdu) = 0.7
     1512    ! #DFB
     1513    coefcoli_spla(:) = 0.
     1514    if(id_prec>0)  coefcoli_spla(id_prec) = -9999.
     1515    if(id_fine>0)  coefcoli_spla(id_fine) = 0.001
     1516    if(id_coss>0)  coefcoli_spla(id_coss) = 0.001
     1517    if(id_codu>0)  coefcoli_spla(id_codu) = 0.001
     1518    if(id_scdu>0)  coefcoli_spla(id_scdu) = 0.001
     1519
     1520    !vdep_lic = (/0.2, 0.17, 1.2, 1.2/)
     1521
     1522    iscm3 = .false.
     1523    if (debutphy) then
     1524      !$OMP MASTER
     1525      CALL suphel
     1526      print *, 'let s check nbtr=', nbtr
     1527      ! JE before put in zero
    15681528      IF (lminmax) THEN
    1569         DO itr=1,nbtr
    1570         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan init phytracr')
    1571         ENDDO
    1572         DO itr=1,nbtr
    1573         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'minmax init phytracr')
    1574         ENDDO
    1575         CALL minmaxsource(source_tr,qmin,qmax,'maxsource init phytracr')
     1529        DO itr = 1, nbtr
     1530          CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan init phytracr')
     1531        ENDDO
     1532        DO itr = 1, nbtr
     1533          CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'minmax init phytracr')
     1534        ENDDO
     1535        CALL minmaxsource(source_tr, qmin, qmax, 'maxsource init phytracr')
    15761536      ENDIF
    1577 ! JE   initializon to cero the tracers     
    1578 !         DO itr=1,nbtr
    1579 !            tr_seri(:,:,itr)=0.0
    1580 !         ENDDO
    1581 ! JE end     
    1582 ! Initializing to zero tr_seri for comparison purposes
    1583 !        tr_seri(:,:,:)=0.0
    1584 !
    1585 !        DO itr=1,nbtr
    1586 !           trm_aux(itr)=0.0
    1587 !           src_aux(itr)=0.0
    1588 !           diag_trm(itr)=0.0
    1589 !           diag_drydep(itr)=0.0
    1590 !           diag_wetdep(itr)=0.0
    1591 !           diag_cvtdep(itr)=0.0
    1592 !           diag_emissn(itr)=0.0
    1593 !        ENDDO
    1594 !        diag_g2part=0.0
    1595          print *,'PREPARE FILES TO SAVE VARIABLES'
    1596 !
    1597          nbjour=30
    1598          ecrit_tra =   NINT(86400./pdtphys)                    !--1-day  average
    1599          ecrit_tra_h = NINT(86400./pdtphys*0.25)               !--6-hour average
    1600          ecrit_tra_m = NINT(86400./pdtphys*FLOAT(nbjour))      !--1-mth  average
    1601          print *,'ecrit_tra=', pdtphys, ecrit_tra
    1602 
    1603 !!AS deleting lines
    1604 !!         IF (ok_histrac) THEN
    1605 !!           IF (is_mpi_root .AND. is_omp_root) THEN
    1606 !!-----many deleted lines----
    1607 !!!       nbjour=1
    1608 !!         ENDIF ! mpi root
    1609 !!         ENDIF !--ok_histrac
    1610 
    1611 !$OMP END MASTER
    1612 !$OMP BARRIER
    1613       endif ! debutphy
    1614 !
    1615 !======================================================================
    1616 ! Initialisations
    1617 !======================================================================
    1618 !
    1619 !
    1620 ! je  KE init
    1621       IF (debutphy) THEN
    1622 !$OMP MASTER
    1623 
    1624       ALLOCATE(d_tr_dry(klon,nbtr))
    1625       ALLOCATE(flux_tr_dry(klon,nbtr),d_tr_dec(klon,klev,nbtr))
    1626       ALLOCATE(qPrls(klon,nbtr),qPr(klon,klev,nbtr))
    1627       ALLOCATE(qDi(klon,klev,nbtr))
    1628       ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr))
    1629       ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr))
    1630 
    1631 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1632 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1633        ALLOCATE(d_tr_cv_o(klon,klev,nbtr))
    1634        ALLOCATE(d_tr_trsp_o(klon,klev,nbtr))
    1635        ALLOCATE(d_tr_sscav_o(klon,klev,nbtr), &
    1636                 d_tr_sat_o(klon,klev,nbtr))
    1637         ALLOCATE(d_tr_uscav_o(klon,klev,nbtr))
    1638 
    1639 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1640 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1641         ALLOCATE(d_tr_insc_o(klon,klev,nbtr))
    1642         ALLOCATE(d_tr_bcscav_o(klon,klev,nbtr))
    1643         ALLOCATE(d_tr_evapls_o(klon,klev,nbtr))
    1644         ALLOCATE(d_tr_ls_o(klon,klev,nbtr))
    1645         ALLOCATE(d_tr_dyn_o(klon,klev,nbtr))
    1646         ALLOCATE(d_tr_cl_o(klon,klev,nbtr))
    1647         ALLOCATE(d_tr_th_o(klon,klev,nbtr))
    1648 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1649 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1650         ALLOCATE(iregion_so4(klon))
    1651         ALLOCATE(iregion_bb(klon))
    1652         ALLOCATE(iregion_ind(klon))
    1653         ALLOCATE(iregion_dust(klon))
    1654         ALLOCATE(iregion_wstardust(klon))
    1655 
    1656 !JE20150518<<
    1657        ALLOCATE(masque_aqua(klon)) 
    1658        ALLOCATE(masque_terra(klon)) 
    1659  
    1660 
    1661        masque_aqua(:)=0
    1662        masque_terra(:)=0
    1663 
    1664       aod550_terra(:)=0. 
    1665       aod550_tr2_terra(:)=0. 
    1666       aod550_ss_terra(:)=0.   
    1667       aod550_dust_terra(:)=0.   
    1668       aod550_dustsco_terra(:)=0.   
    1669       aod670_terra(:)=0.   
    1670       aod670_tr2_terra(:)=0. 
    1671       aod670_ss_terra(:)=0. 
    1672       aod670_dust_terra(:)=0. 
    1673       aod670_dustsco_terra(:)=0. 
    1674       aod865_terra(:)=0.   
    1675       aod865_tr2_terra(:)=0. 
    1676       aod865_ss_terra(:)=0. 
    1677       aod865_dust_terra(:)=0. 
    1678       aod865_dustsco_terra(:)=0. 
    1679       aod550_aqua(:)=0. 
    1680       aod550_tr2_aqua(:)=0. 
    1681       aod550_ss_aqua(:)=0.   
    1682       aod550_dust_aqua(:)=0.   
    1683       aod550_dustsco_aqua(:)=0.   
    1684       aod670_aqua(:)=0.   
    1685       aod670_tr2_aqua(:)=0. 
    1686       aod670_ss_aqua(:)=0. 
    1687       aod670_dust_aqua(:)=0. 
    1688       aod670_dustsco_aqua(:)=0. 
    1689       aod865_aqua(:)=0.   
    1690       aod865_tr2_aqua(:)=0. 
    1691       aod865_ss_aqua(:)=0. 
    1692       aod865_dust_aqua(:)=0. 
    1693       aod865_dustsco_aqua(:)=0. 
    1694 !JE20150518>>
    1695 
    1696 
    1697 
    1698 
    1699 
    1700 !
    1701 !Config Key  = iflag_lscav
    1702 !Config Desc = Large scale scavenging parametrization: 0=none,
    1703 !1=old(Genthon92),
    1704 !              2=1+PHeinrich, 3=Reddy_Boucher2004, 4=3+RPilon.
    1705 !Config Def  = 4
    1706 !Config
    1707         iflag_lscav_omp=4
    1708         call getin('iflag_lscav', iflag_lscav_omp)
    1709         iflag_lscav=iflag_lscav_omp
    1710 ! initialiation for time computation
    1711 
    1712         tia_spla=0.
    1713         tia_emis=0.
    1714         tia_depo=0.
    1715         tia_cltr=0.
    1716         tia_ther=0.
    1717         tia_sedi=0.
    1718         tia_gasp=0.
    1719         tia_wetap=0.
    1720         tia_cvltr=0.
    1721         tia_lscs=0.
    1722         tia_brop=0.
    1723         tia_outs=0.
    1724         tia_nophytracr=0.
    1725         clock_start_outphytracr=clock_end_outphytracr+1
    1726 !$OMP END MASTER
    1727 !$OMP BARRIER
    1728        ENDIF ! debutphy
    1729      
    1730       lmt_dms(:)=0.0
    1731       aux_var2(:)=0.0
    1732       aux_var3(:,:)=0.0
    1733       source_tr(:,:)=0.0
    1734       flux_tr(:,:)=0.0
    1735       flux_sparam_bb(:)=0.0
    1736       flux_sparam_ff(:)=0.0
    1737       flux_sparam_ind(:)=0.0
    1738       flux_sparam_ddfine(:)=0.0
    1739       flux_sparam_ddcoa(:)=0.0
    1740       flux_sparam_ddsco(:)=0.0
    1741       flux_sparam_ssfine(:)=0.0
    1742       flux_sparam_sscoa(:)=0.0
    1743 
    1744 ! initialiation for time computation
    1745        
    1746         ti_spla=0
    1747         ti_emis=0
    1748         ti_depo=0
    1749         ti_cltr=0
    1750         ti_ther=0
    1751         ti_sedi=0
    1752         ti_gasp=0
    1753         ti_wetap=0
    1754         ti_cvltr=0
    1755         ti_lscs=0
    1756         ti_brop=0
    1757         ti_outs=0
    1758 
    1759 
    1760        DO k=1,klev
    1761         DO i=1,klon
    1762          Mint(i,k)=0.
     1537      ! JE   initializon to cero the tracers
     1538      !         DO itr=1,nbtr
     1539      !            tr_seri(:,:,itr)=0.0
     1540      !         ENDDO
     1541      ! JE end
     1542      ! Initializing to zero tr_seri for comparison purposes
     1543      !        tr_seri(:,:,:)=0.0
     1544
     1545      !        DO itr=1,nbtr
     1546      !           trm_aux(itr)=0.0
     1547      !           src_aux(itr)=0.0
     1548      !           diag_trm(itr)=0.0
     1549      !           diag_drydep(itr)=0.0
     1550      !           diag_wetdep(itr)=0.0
     1551      !           diag_cvtdep(itr)=0.0
     1552      !           diag_emissn(itr)=0.0
     1553      !        ENDDO
     1554      !        diag_g2part=0.0
     1555      print *, 'PREPARE FILES TO SAVE VARIABLES'
     1556
     1557      nbjour = 30
     1558      ecrit_tra = NINT(86400. / pdtphys)                    !--1-day  average
     1559      ecrit_tra_h = NINT(86400. / pdtphys * 0.25)               !--6-hour average
     1560      ecrit_tra_m = NINT(86400. / pdtphys * FLOAT(nbjour))      !--1-mth  average
     1561      print *, 'ecrit_tra=', pdtphys, ecrit_tra
     1562
     1563      !!AS deleting lines
     1564      !!         IF (ok_histrac) THEN
     1565      !!           IF (is_mpi_root .AND. is_omp_root) THEN
     1566      !!-----many deleted lines----
     1567      !!!       nbjour=1
     1568      !!         ENDIF ! mpi root
     1569      !!         ENDIF !--ok_histrac
     1570
     1571      !$OMP END MASTER
     1572      !$OMP BARRIER
     1573    endif ! debutphy
     1574
     1575    !======================================================================
     1576    ! Initialisations
     1577    !======================================================================
     1578
     1579
     1580    ! je  KE init
     1581    IF (debutphy) THEN
     1582      !$OMP MASTER
     1583
     1584      ALLOCATE(d_tr_dry(klon, nbtr))
     1585      ALLOCATE(flux_tr_dry(klon, nbtr), d_tr_dec(klon, klev, nbtr))
     1586      ALLOCATE(qPrls(klon, nbtr), qPr(klon, klev, nbtr))
     1587      ALLOCATE(qDi(klon, klev, nbtr))
     1588      ALLOCATE(qPa(klon, klev, nbtr), qMel(klon, klev, nbtr))
     1589      ALLOCATE(qTrdi(klon, klev, nbtr), dtrcvMA(klon, klev, nbtr))
     1590
     1591      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1592      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1593      ALLOCATE(d_tr_cv_o(klon, klev, nbtr))
     1594      ALLOCATE(d_tr_trsp_o(klon, klev, nbtr))
     1595      ALLOCATE(d_tr_sscav_o(klon, klev, nbtr), &
     1596              d_tr_sat_o(klon, klev, nbtr))
     1597      ALLOCATE(d_tr_uscav_o(klon, klev, nbtr))
     1598
     1599      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1600      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1601      ALLOCATE(d_tr_insc_o(klon, klev, nbtr))
     1602      ALLOCATE(d_tr_bcscav_o(klon, klev, nbtr))
     1603      ALLOCATE(d_tr_evapls_o(klon, klev, nbtr))
     1604      ALLOCATE(d_tr_ls_o(klon, klev, nbtr))
     1605      ALLOCATE(d_tr_dyn_o(klon, klev, nbtr))
     1606      ALLOCATE(d_tr_cl_o(klon, klev, nbtr))
     1607      ALLOCATE(d_tr_th_o(klon, klev, nbtr))
     1608      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1609      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1610      ALLOCATE(iregion_so4(klon))
     1611      ALLOCATE(iregion_bb(klon))
     1612      ALLOCATE(iregion_ind(klon))
     1613      ALLOCATE(iregion_dust(klon))
     1614      ALLOCATE(iregion_wstardust(klon))
     1615
     1616      !JE20150518<<
     1617      ALLOCATE(masque_aqua(klon))
     1618      ALLOCATE(masque_terra(klon))
     1619
     1620      masque_aqua(:) = 0
     1621      masque_terra(:) = 0
     1622
     1623      aod550_terra(:) = 0.
     1624      aod550_tr2_terra(:) = 0.
     1625      aod550_ss_terra(:) = 0.
     1626      aod550_dust_terra(:) = 0.
     1627      aod550_dustsco_terra(:) = 0.
     1628      aod670_terra(:) = 0.
     1629      aod670_tr2_terra(:) = 0.
     1630      aod670_ss_terra(:) = 0.
     1631      aod670_dust_terra(:) = 0.
     1632      aod670_dustsco_terra(:) = 0.
     1633      aod865_terra(:) = 0.
     1634      aod865_tr2_terra(:) = 0.
     1635      aod865_ss_terra(:) = 0.
     1636      aod865_dust_terra(:) = 0.
     1637      aod865_dustsco_terra(:) = 0.
     1638      aod550_aqua(:) = 0.
     1639      aod550_tr2_aqua(:) = 0.
     1640      aod550_ss_aqua(:) = 0.
     1641      aod550_dust_aqua(:) = 0.
     1642      aod550_dustsco_aqua(:) = 0.
     1643      aod670_aqua(:) = 0.
     1644      aod670_tr2_aqua(:) = 0.
     1645      aod670_ss_aqua(:) = 0.
     1646      aod670_dust_aqua(:) = 0.
     1647      aod670_dustsco_aqua(:) = 0.
     1648      aod865_aqua(:) = 0.
     1649      aod865_tr2_aqua(:) = 0.
     1650      aod865_ss_aqua(:) = 0.
     1651      aod865_dust_aqua(:) = 0.
     1652      aod865_dustsco_aqua(:) = 0.
     1653      !JE20150518>>
     1654
     1655      !Config Key  = iflag_lscav
     1656      !Config Desc = Large scale scavenging parametrization: 0=none,
     1657      !1=old(Genthon92),
     1658      !              2=1+PHeinrich, 3=Reddy_Boucher2004, 4=3+RPilon.
     1659      !Config Def  = 4
     1660      !Config
     1661      iflag_lscav_omp = 4
     1662      call getin('iflag_lscav', iflag_lscav_omp)
     1663      iflag_lscav = iflag_lscav_omp
     1664      ! initialiation for time computation
     1665
     1666      tia_spla = 0.
     1667      tia_emis = 0.
     1668      tia_depo = 0.
     1669      tia_cltr = 0.
     1670      tia_ther = 0.
     1671      tia_sedi = 0.
     1672      tia_gasp = 0.
     1673      tia_wetap = 0.
     1674      tia_cvltr = 0.
     1675      tia_lscs = 0.
     1676      tia_brop = 0.
     1677      tia_outs = 0.
     1678      tia_nophytracr = 0.
     1679      clock_start_outphytracr = clock_end_outphytracr + 1
     1680      !$OMP END MASTER
     1681      !$OMP BARRIER
     1682    ENDIF ! debutphy
     1683
     1684    lmt_dms(:) = 0.0
     1685    aux_var2(:) = 0.0
     1686    aux_var3(:, :) = 0.0
     1687    source_tr(:, :) = 0.0
     1688    flux_tr(:, :) = 0.0
     1689    flux_sparam_bb(:) = 0.0
     1690    flux_sparam_ff(:) = 0.0
     1691    flux_sparam_ind(:) = 0.0
     1692    flux_sparam_ddfine(:) = 0.0
     1693    flux_sparam_ddcoa(:) = 0.0
     1694    flux_sparam_ddsco(:) = 0.0
     1695    flux_sparam_ssfine(:) = 0.0
     1696    flux_sparam_sscoa(:) = 0.0
     1697
     1698    ! initialiation for time computation
     1699
     1700    ti_spla = 0
     1701    ti_emis = 0
     1702    ti_depo = 0
     1703    ti_cltr = 0
     1704    ti_ther = 0
     1705    ti_sedi = 0
     1706    ti_gasp = 0
     1707    ti_wetap = 0
     1708    ti_cvltr = 0
     1709    ti_lscs = 0
     1710    ti_brop = 0
     1711    ti_outs = 0
     1712
     1713    DO k = 1, klev
     1714      DO i = 1, klon
     1715        Mint(i, k) = 0.
     1716      END DO
     1717    END DO
     1718
     1719    DO itr = 1, nbtr
     1720      DO k = 1, klev
     1721        DO i = 1, klon
     1722          d_tr_cv(i, k, itr) = 0.
     1723          d_tr_trsp(i, k, itr) = 0.
     1724          d_tr_sscav(i, k, itr) = 0.
     1725          d_tr_sat(i, k, itr) = 0.
     1726          d_tr_uscav(i, k, itr) = 0.
     1727          d_tr(i, k, itr) = 0.
     1728          d_tr_insc(i, k, itr) = 0.
     1729          d_tr_bcscav(i, k, itr) = 0.
     1730          d_tr_evapls(i, k, itr) = 0.
     1731          d_tr_ls(i, k, itr) = 0.
     1732          d_tr_cl(i, k, itr) = 0.
     1733          d_tr_th(i, k, itr) = 0.
     1734
     1735          d_tr_cv_o(i, k, itr) = 0.
     1736          d_tr_trsp_o(i, k, itr) = 0.
     1737          d_tr_sscav_o(i, k, itr) = 0.
     1738          d_tr_sat_o(i, k, itr) = 0.
     1739          d_tr_uscav_o(i, k, itr) = 0.
     1740
     1741          qDi(i, k, itr) = 0.
     1742          qPr(i, k, itr) = 0.
     1743          qPa(i, k, itr) = 0.
     1744          qMel(i, k, itr) = 0.
     1745          qTrdi(i, k, itr) = 0.
     1746          dtrcvMA(i, k, itr) = 0.
     1747          zmfd1a(i, k, itr) = 0.
     1748          zmfdam(i, k, itr) = 0.
     1749          zmfphi2(i, k, itr) = 0.
    17631750        END DO
    1764        END DO
    1765 
    1766 
    1767 !
    1768       DO itr=1,nbtr
    1769        DO k=1,klev
    1770         DO i=1,klon
    1771          d_tr_cv(i,k,itr)=0.
    1772          d_tr_trsp(i,k,itr)=0.
    1773          d_tr_sscav(i,k,itr)=0.
    1774          d_tr_sat(i,k,itr)=0.
    1775          d_tr_uscav(i,k,itr)=0.
    1776          d_tr(i,k,itr)=0.
    1777          d_tr_insc(i,k,itr)=0.
    1778          d_tr_bcscav(i,k,itr)=0.
    1779          d_tr_evapls(i,k,itr)=0.
    1780          d_tr_ls(i,k,itr)=0.
    1781          d_tr_cl(i,k,itr)=0.
    1782          d_tr_th(i,k,itr)=0.
    1783  
    1784          d_tr_cv_o(i,k,itr)=0.
    1785          d_tr_trsp_o(i,k,itr)=0.
    1786          d_tr_sscav_o(i,k,itr)=0.
    1787          d_tr_sat_o(i,k,itr)=0.
    1788          d_tr_uscav_o(i,k,itr)=0.
    1789 
    1790 
    1791          qDi(i,k,itr)=0.
    1792          qPr(i,k,itr)=0.
    1793          qPa(i,k,itr)=0.
    1794          qMel(i,k,itr)=0.
    1795          qTrdi(i,k,itr)=0.
    1796          dtrcvMA(i,k,itr)=0.
    1797          zmfd1a(i,k,itr)=0.
    1798          zmfdam(i,k,itr)=0.
    1799          zmfphi2(i,k,itr)=0.
    1800         END DO
    1801        END DO
    18021751      END DO
    1803 
    1804 
    1805       DO itr=1,nbtr
    1806        DO i=1,klon
    1807           qPrls(i,itr)=0.0
    1808           dtrconv(i,itr)=0.0
    1809 !JE20140507<<
    1810           d_tr_dry(i,itr)=0.0
    1811           flux_tr_dry(i,itr)=0.0
    1812 !JE20140507>>
    1813        ENDDO
    1814       ENDDO
    1815 
    1816       DO itr=1,nbtr
    1817       DO i=1, klon
    1818         his_dh(i,itr)=0.0
    1819         his_dhlsc(i,itr)=0.0
    1820         his_dhcon(i,itr)=0.0
    1821         his_dhbclsc(i,itr)=0.0
    1822         his_dhbccon(i,itr)=0.0
    1823         trm(i,itr)=0.0
    1824         his_th(i,itr)=0.0
    1825         his_dhkecv(i,itr)=0.0
    1826         his_ds(i,itr)=0.0
    1827         his_dhkelsc(i,itr)=0.0
    1828 
    1829       ENDDO
    1830       ENDDO
    1831 !JE:     
    1832       DO i=1, klon
    1833          his_g2pgas(i) = 0.0
    1834          his_g2paer(i) = 0.0
    1835       ENDDO
    1836 ! endJE
    1837 !
    1838 
    1839       DO k=1, klev
     1752    END DO
     1753
     1754    DO itr = 1, nbtr
    18401755      DO i = 1, klon
    1841         zrho(i,k)=pplay(i,k)/t_seri(i,k)/RD
    1842         zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG
    1843         zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/RG
    1844       ENDDO
    1845       ENDDO
    1846 !
     1756        qPrls(i, itr) = 0.0
     1757        dtrconv(i, itr) = 0.0
     1758        !JE20140507<<
     1759        d_tr_dry(i, itr) = 0.0
     1760        flux_tr_dry(i, itr) = 0.0
     1761        !JE20140507>>
     1762      ENDDO
     1763    ENDDO
     1764
     1765    DO itr = 1, nbtr
    18471766      DO i = 1, klon
    1848         zalt(i,1)=pphis(i)/RG
    1849       ENDDO
    1850       DO k=1, klev-1
     1767        his_dh(i, itr) = 0.0
     1768        his_dhlsc(i, itr) = 0.0
     1769        his_dhcon(i, itr) = 0.0
     1770        his_dhbclsc(i, itr) = 0.0
     1771        his_dhbccon(i, itr) = 0.0
     1772        trm(i, itr) = 0.0
     1773        his_th(i, itr) = 0.0
     1774        his_dhkecv(i, itr) = 0.0
     1775        his_ds(i, itr) = 0.0
     1776        his_dhkelsc(i, itr) = 0.0
     1777
     1778      ENDDO
     1779    ENDDO
     1780    !JE:
     1781    DO i = 1, klon
     1782      his_g2pgas(i) = 0.0
     1783      his_g2paer(i) = 0.0
     1784    ENDDO
     1785    ! endJE
     1786
     1787    DO k = 1, klev
    18511788      DO i = 1, klon
    1852         zalt(i,k+1)=zalt(i,k)+zdz(i,k)
    1853       ENDDO
    1854       ENDDO
    1855 
    1856 
    1857 
    1858       IF (logitime) THEN
    1859       CALL SYSTEM_CLOCK(COUNT=clock_end)
    1860       dife=clock_end-clock_start
    1861       ti_init=dife*MAX(0,SIGN(1,dife)) &
    1862       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    1863       tia_init=tia_init+REAL(ti_init)/REAL(clock_rate)
    1864       ENDIF
    1865       IF (logitime) THEN
    1866       CALL SYSTEM_CLOCK(COUNT=clock_start)
    1867       ENDIF
    1868 
    1869 
    1870       IF (debutphy) then
    1871 
    1872 ! AS: initialisation des indices par point de grille physique iregion_*
    1873 ! (variables tenant de l'assimilation, a eliminer dans un 2eme temps)
    1874        iregion_dust(:)=1
    1875        iregion_ind(:)=1
    1876        iregion_bb(:)=1
    1877        iregion_wstardust(:)=1
    1878 
    1879 !AS: lecture des indices dans fichiers "regions_*" eliminee par IF("ASSIM"="YES") (faux donc)
    1880        IF("ASSIM"=="YES") THEN
    1881       c_FullName1='regions_dustacc'
    1882       !c_FullName1='regions_dust'
    1883       call readregions_spl(iregion_dust,c_FullName1)
    1884       c_FullName1='regions_ind'
    1885       call readregions_spl(iregion_ind,c_FullName1)
    1886       c_FullName1='regions_bb'
    1887       call readregions_spl(iregion_bb,c_FullName1)
    1888       c_FullName1='regions_pwstarwake'
    1889       call readregions_spl(iregion_wstardust,c_FullName1)
    1890 
    1891 !$OMP MASTER
     1789        zrho(i, k) = pplay(i, k) / t_seri(i, k) / RD
     1790        zdz(i, k) = (paprs(i, k) - paprs(i, k + 1)) / zrho(i, k) / RG
     1791        zmasse(i, k) = (paprs(i, k) - paprs(i, k + 1)) / RG
     1792      ENDDO
     1793    ENDDO
     1794
     1795    DO i = 1, klon
     1796      zalt(i, 1) = pphis(i) / RG
     1797    ENDDO
     1798    DO k = 1, klev - 1
     1799      DO i = 1, klon
     1800        zalt(i, k + 1) = zalt(i, k) + zdz(i, k)
     1801      ENDDO
     1802    ENDDO
     1803
     1804    IF (logitime) THEN
     1805      CALL SYSTEM_CLOCK(COUNT = clock_end)
     1806      dife = clock_end - clock_start
     1807      ti_init = dife * MAX(0, SIGN(1, dife)) &
     1808              + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     1809      tia_init = tia_init + REAL(ti_init) / REAL(clock_rate)
     1810    ENDIF
     1811    IF (logitime) THEN
     1812      CALL SYSTEM_CLOCK(COUNT = clock_start)
     1813    ENDIF
     1814
     1815    IF (debutphy) then
     1816
     1817      ! AS: initialisation des indices par point de grille physique iregion_*
     1818      ! (variables tenant de l'assimilation, a eliminer dans un 2eme temps)
     1819      iregion_dust(:) = 1
     1820      iregion_ind(:) = 1
     1821      iregion_bb(:) = 1
     1822      iregion_wstardust(:) = 1
     1823
     1824      !AS: lecture des indices dans fichiers "regions_*" eliminee par IF("ASSIM"="YES") (faux donc)
     1825      IF("ASSIM"=="YES") THEN
     1826        c_FullName1 = 'regions_dustacc'
     1827        !c_FullName1='regions_dust'
     1828        call readregions_spl(iregion_dust, c_FullName1)
     1829        c_FullName1 = 'regions_ind'
     1830        call readregions_spl(iregion_ind, c_FullName1)
     1831        c_FullName1 = 'regions_bb'
     1832        call readregions_spl(iregion_bb, c_FullName1)
     1833        c_FullName1 = 'regions_pwstarwake'
     1834        call readregions_spl(iregion_wstardust, c_FullName1)
     1835
     1836        !$OMP MASTER
     1837        IF (is_mpi_root .AND. is_omp_root) THEN
     1838
     1839          OPEN(25, FILE = 'dustregions_pyvar_je.data')
     1840          OPEN(55, FILE = 'indregions_pyvar_je.data')
     1841          OPEN(75, FILE = 'bbregions_pyvar_je.data')
     1842          OPEN(95, FILE = 'wstardustregions_pyvar_je.data')
     1843          OPEN(76, FILE = 'xlat.data')
     1844          OPEN(77, FILE = 'xlon.data')
     1845        ENDIF ! mpi root
     1846        !$OMP END MASTER
     1847        !$OMP BARRIER
     1848
     1849        CALL gather(iregion_dust, iauxklon_glo)
     1850        !$OMP MASTER
     1851        IF (is_mpi_root .AND. is_omp_root) THEN
     1852          DO k = 1, klon_glo
     1853            WRITE(25, '(i10)') iauxklon_glo(k)
     1854          ENDDO
     1855        ENDIF ! mpi root
     1856        !$OMP END MASTER
     1857        !$OMP BARRIER
     1858        CALL gather(iregion_ind, iauxklon_glo)
     1859        !$OMP MASTER
     1860        IF (is_mpi_root .AND. is_omp_root) THEN
     1861          DO k = 1, klon_glo
     1862            WRITE(55, '(i10)') iauxklon_glo(k)
     1863          ENDDO
     1864        ENDIF ! mpi root
     1865        !$OMP END MASTER
     1866        !$OMP BARRIER
     1867        CALL gather(iregion_bb, iauxklon_glo)
     1868        !$OMP MASTER
     1869        IF (is_mpi_root .AND. is_omp_root) THEN
     1870          DO k = 1, klon_glo
     1871            WRITE(75, '(i10)') iauxklon_glo(k)
     1872          ENDDO
     1873        ENDIF ! mpi root
     1874        !$OMP END MASTER
     1875        !$OMP BARRIER
     1876        CALL gather(iregion_wstardust, iauxklon_glo)
     1877        !$OMP MASTER
     1878        IF (is_mpi_root .AND. is_omp_root) THEN
     1879          DO k = 1, klon_glo
     1880            WRITE(95, '(i10)') iauxklon_glo(k)
     1881          ENDDO
     1882        ENDIF ! mpi root
     1883        !$OMP END MASTER
     1884        !$OMP BARRIER
     1885
     1886        CALL gather(rlat, auxklon_glo)
     1887        !$OMP MASTER
     1888        IF (is_mpi_root .AND. is_omp_root) THEN
     1889          DO k = 1, klon_glo
     1890            WRITE(76, *) auxklon_glo(k)
     1891          ENDDO
     1892        ENDIF ! mpi root
     1893        !$OMP END MASTER
     1894        !$OMP BARRIER
     1895        CALL gather(rlon, auxklon_glo)
     1896        !$OMP MASTER
     1897        IF (is_mpi_root .AND. is_omp_root) THEN
     1898          DO k = 1, klon_glo
     1899            WRITE(77, *) auxklon_glo(k)
     1900          ENDDO
     1901
     1902          CLOSE(25)
     1903          CLOSE(55)
     1904          CLOSE(75)
     1905          CLOSE(76)
     1906          CLOSE(77)
     1907          CLOSE(95)
     1908
     1909        ENDIF ! mpi root
     1910        !$OMP END MASTER
     1911        !$OMP BARRIER
     1912
     1913      ENDIF  ! ASSIM
     1914
     1915    ENDIF  ! debutphy
     1916
     1917    IF (logitime) THEN
     1918      CALL SYSTEM_CLOCK(COUNT = clock_end)
     1919      dife = clock_end - clock_start
     1920      ti_inittype = dife * MAX(0, SIGN(1, dife)) &
     1921              + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     1922      tia_inittype = tia_inittype + REAL(ti_inittype) / REAL(clock_rate)
     1923    ENDIF
     1924
     1925    IF (logitime) THEN
     1926      CALL SYSTEM_CLOCK(COUNT = clock_start)
     1927    ENDIF
     1928
     1929    !=======================================================================
     1930    ! SAVING SURFACE TYPE
     1931    !=======================================================================
     1932    IF (debutphy) THEN
     1933      !$OMP MASTER
    18921934      IF (is_mpi_root .AND. is_omp_root) THEN
    1893      
    1894       OPEN(25,FILE='dustregions_pyvar_je.data')
    1895       OPEN(55,FILE='indregions_pyvar_je.data')
    1896       OPEN(75,FILE='bbregions_pyvar_je.data')
    1897       OPEN(95,FILE='wstardustregions_pyvar_je.data')
    1898       OPEN(76,FILE='xlat.data')
    1899       OPEN(77,FILE='xlon.data')
     1935
     1936        OPEN(35, FILE = 'surface_ocean.data')
     1937        OPEN(45, FILE = 'surface_seaice.data')
     1938        OPEN(65, FILE = 'surface_land.data')
     1939        OPEN(85, FILE = 'surface_landice.data')
    19001940      ENDIF ! mpi root
    1901 !$OMP END MASTER
    1902 !$OMP BARRIER
    1903 
    1904       CALL gather(iregion_dust,iauxklon_glo)
    1905 !$OMP MASTER
     1941      !$OMP END MASTER
     1942      !$OMP BARRIER
     1943      do i = 1, klon
     1944        aux_var2(i) = pctsrf(i, is_oce)
     1945      enddo
     1946      call gather(aux_var2, auxklon_glo)
     1947      !$OMP MASTER
    19061948      IF (is_mpi_root .AND. is_omp_root) THEN
    1907       DO k=1,klon_glo
    1908         WRITE(25,'(i10)') iauxklon_glo(k)
    1909       ENDDO
     1949        DO i = 1, klon_glo
     1950          WRITE (35, 103)  auxklon_glo(i)
     1951        ENDDO
    19101952      ENDIF ! mpi root
    1911 !$OMP END MASTER
    1912 !$OMP BARRIER
    1913       CALL gather(iregion_ind,iauxklon_glo)
    1914 !$OMP MASTER
     1953      !$OMP END MASTER
     1954      !$OMP BARRIER
     1955
     1956      do i = 1, klon
     1957        aux_var2(i) = pctsrf(i, is_sic)
     1958      enddo
     1959      call gather(aux_var2, auxklon_glo)
     1960      !$OMP MASTER
    19151961      IF (is_mpi_root .AND. is_omp_root) THEN
    1916       DO k=1,klon_glo
    1917         WRITE(55,'(i10)') iauxklon_glo(k)
    1918       ENDDO
     1962        DO i = 1, klon_glo
     1963          WRITE (45, 103)  auxklon_glo(i)
     1964        ENDDO
    19191965      ENDIF ! mpi root
    1920 !$OMP END MASTER
    1921 !$OMP BARRIER
    1922       CALL gather(iregion_bb,iauxklon_glo)
    1923 !$OMP MASTER
     1966      !$OMP END MASTER
     1967      !$OMP BARRIER
     1968
     1969      do i = 1, klon
     1970        aux_var2(i) = pctsrf(i, is_ter)
     1971      enddo
     1972      call gather(aux_var2, auxklon_glo)
     1973      !$OMP MASTER
    19241974      IF (is_mpi_root .AND. is_omp_root) THEN
    1925       DO k=1,klon_glo
    1926         WRITE(75,'(i10)') iauxklon_glo(k)
    1927       ENDDO
     1975        DO i = 1, klon_glo
     1976          WRITE (65, 103)  auxklon_glo(i)
     1977        ENDDO
    19281978      ENDIF ! mpi root
    1929 !$OMP END MASTER
    1930 !$OMP BARRIER
    1931       CALL gather(iregion_wstardust,iauxklon_glo)
    1932 !$OMP MASTER
     1979      !$OMP END MASTER
     1980      !$OMP BARRIER
     1981
     1982      do i = 1, klon
     1983        aux_var2(i) = pctsrf(i, is_lic)
     1984      enddo
     1985      call gather(aux_var2, auxklon_glo)
     1986      !$OMP MASTER
    19331987      IF (is_mpi_root .AND. is_omp_root) THEN
    1934       DO k=1,klon_glo
    1935         WRITE(95,'(i10)') iauxklon_glo(k)
    1936       ENDDO
     1988        DO i = 1, klon_glo
     1989          WRITE (85, 103)  auxklon_glo(i)
     1990        ENDDO
     1991
     1992        !      DO i = 1, klon
     1993        !         WRITE (35,103) pctsrf(i,is_oce)
     1994        !         WRITE (45,103) pctsrf(i,is_sic)
     1995        !         WRITE (65,103) pctsrf(i,is_ter)
     1996        !         WRITE (85,103) pctsrf(i,is_lic)
     1997        !      ENDDO
     1998        CLOSE(35)
     1999        CLOSE(45)
     2000        CLOSE(65)
     2001        CLOSE(85)
     2002        103   FORMAT (f6.2)
    19372003      ENDIF ! mpi root
    1938 !$OMP END MASTER
    1939 !$OMP BARRIER
    1940 
    1941 
    1942       CALL gather(rlat,auxklon_glo)
    1943 !$OMP MASTER
    1944       IF (is_mpi_root .AND. is_omp_root) THEN
    1945       DO k=1,klon_glo
    1946         WRITE(76,*) auxklon_glo(k)
    1947       ENDDO
    1948       ENDIF ! mpi root
    1949 !$OMP END MASTER
    1950 !$OMP BARRIER
    1951       CALL gather(rlon,auxklon_glo)
    1952 !$OMP MASTER
    1953       IF (is_mpi_root .AND. is_omp_root) THEN
    1954       DO k=1,klon_glo
    1955         WRITE(77,*) auxklon_glo(k)
    1956       ENDDO
    1957 
    1958       CLOSE(25)
    1959       CLOSE(55)
    1960       CLOSE(75)
    1961       CLOSE(76)
    1962       CLOSE(77)
    1963       CLOSE(95)
    1964 
    1965       ENDIF ! mpi root
    1966 !$OMP END MASTER
    1967 !$OMP BARRIER
    1968 
    1969       ENDIF  ! ASSIM
    1970 
    1971       ENDIF  ! debutphy
    1972 
    1973       IF (logitime) THEN
    1974       CALL SYSTEM_CLOCK(COUNT=clock_end)
    1975       dife=clock_end-clock_start
    1976       ti_inittype=dife*MAX(0,SIGN(1,dife)) &
    1977       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    1978       tia_inittype=tia_inittype+REAL(ti_inittype)/REAL(clock_rate)
    1979       ENDIF
    1980 
    1981       IF (logitime) THEN
    1982       CALL SYSTEM_CLOCK(COUNT=clock_start)
    1983       ENDIF
    1984 
    1985 !
    1986 !=======================================================================
    1987 ! SAVING SURFACE TYPE
    1988 !=======================================================================
    1989       IF (debutphy) THEN
    1990 !$OMP MASTER
    1991       IF (is_mpi_root .AND. is_omp_root) THEN
    1992 
    1993       OPEN(35,FILE='surface_ocean.data')
    1994       OPEN(45,FILE='surface_seaice.data')
    1995       OPEN(65,FILE='surface_land.data')
    1996       OPEN(85,FILE='surface_landice.data')
    1997       ENDIF ! mpi root
    1998 !$OMP END MASTER
    1999 !$OMP BARRIER
    2000       do i = 1, klon
    2001                 aux_var2(i) = pctsrf(i,is_oce)
    2002       enddo
    2003       call gather(aux_var2,auxklon_glo)
    2004 !$OMP MASTER
    2005       IF (is_mpi_root .AND. is_omp_root) THEN
    2006       DO i = 1, klon_glo
    2007          WRITE (35,103)  auxklon_glo(i)
    2008       ENDDO
    2009       ENDIF ! mpi root
    2010 !$OMP END MASTER
    2011 !$OMP BARRIER
    2012 
    2013       do i = 1, klon
    2014                 aux_var2(i) = pctsrf(i,is_sic)
    2015       enddo
    2016       call gather(aux_var2,auxklon_glo)
    2017 !$OMP MASTER
    2018       IF (is_mpi_root .AND. is_omp_root) THEN
    2019       DO i = 1, klon_glo
    2020          WRITE (45,103)  auxklon_glo(i)
    2021       ENDDO
    2022       ENDIF ! mpi root
    2023 !$OMP END MASTER
    2024 !$OMP BARRIER
    2025 
    2026       do i = 1, klon
    2027                 aux_var2(i) = pctsrf(i,is_ter)
    2028       enddo
    2029       call gather(aux_var2,auxklon_glo)
    2030 !$OMP MASTER
    2031       IF (is_mpi_root .AND. is_omp_root) THEN
    2032       DO i = 1, klon_glo
    2033          WRITE (65,103)  auxklon_glo(i)
    2034       ENDDO
    2035       ENDIF ! mpi root
    2036 !$OMP END MASTER
    2037 !$OMP BARRIER
    2038 
    2039       do i = 1, klon
    2040                 aux_var2(i) = pctsrf(i,is_lic)
    2041       enddo
    2042       call gather(aux_var2,auxklon_glo)
    2043 !$OMP MASTER
    2044       IF (is_mpi_root .AND. is_omp_root) THEN
    2045       DO i = 1, klon_glo
    2046          WRITE (85,103)  auxklon_glo(i)
    2047       ENDDO
    2048 !
    2049 !      DO i = 1, klon
    2050 !         WRITE (35,103) pctsrf(i,is_oce)
    2051 !         WRITE (45,103) pctsrf(i,is_sic)
    2052 !         WRITE (65,103) pctsrf(i,is_ter)
    2053 !         WRITE (85,103) pctsrf(i,is_lic)
    2054 !      ENDDO
    2055       CLOSE(35)
    2056       CLOSE(45)
    2057       CLOSE(65)
    2058       CLOSE(85)
    2059 103   FORMAT (f6.2)
    2060       ENDIF ! mpi root
    2061 !$OMP END MASTER
    2062 !$OMP BARRIER
    2063       ENDIF ! debutphy
    2064 
    2065 !      stop
    2066 !
    2067 !=======================================================================
    2068 !
    2069       DO itr=1,nbtr
    2070         DO j=1,klev
    2071         DO i=1,klon
    2072            tmp_var(i,j)=tr_seri(i,j,itr)
    2073         ENDDO
    2074         ENDDO
    2075         CALL kg_to_cm3(pplay,t_seri,tmp_var)
    2076         DO j=1,klev
    2077         DO i=1,klon
    2078            tr_seri(i,j,itr)=tmp_var(i,j)
    2079         ENDDO
    2080         ENDDO
    2081       ENDDO
    2082       iscm3=.true.
    2083 
    2084 !=======================================================================
    2085 !
    2086       DO k=1, klev
    2087       DO i=1, klon
    2088         m_conc(i,k)=pplay(i,k)/t_seri(i,k)/RKBOL*1.e-6
    2089       ENDDO
    2090       ENDDO
    2091 
    2092 !
    2093 !
    2094       IF (lminmax) THEN
    2095         DO itr=1,nbtr
    2096         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_avt_coarem')
    2097         ENDDO       
    2098         DO itr=1,nbtr
    2099         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'avt coarem')
    2100         ENDDO
    2101         CALL minmaxsource(source_tr,qmin,qmax,'src: avt coarem')
    2102       ENDIF
    2103 
    2104       IF (logitime) THEN
    2105       CALL SYSTEM_CLOCK(COUNT=clock_end)
    2106       dife=clock_end-clock_start
    2107       ti_inittwrite=dife*MAX(0,SIGN(1,dife))  &
    2108       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    2109       tia_inittwrite=tia_inittwrite+REAL(ti_inittwrite)/REAL(clock_rate)
    2110       ENDIF
    2111 
    2112 !
    2113 !
    2114 !=======================================================================
    2115 !                     EMISSIONS OF COARSE AEROSOLS
    2116 !=======================================================================
    2117 
    2118 
    2119       IF (logitime) THEN
    2120       CALL SYSTEM_CLOCK(COUNT=clock_start)
    2121       ENDIF
    2122 
    2123 
    2124 
    2125 !     
    2126       print *,'Number of tracers = ',nbtr
    2127 
    2128       print *,'AT BEGINNING OF PHYTRACR_SPL'
    2129 !      print *,'tr_seri = ',SUM(tr_seri(:,:,3)),MINVAL(tr_seri(:,:,3)),
    2130 !     .                                         MAXVAL(tr_seri(:,:,3))
     2004      !$OMP END MASTER
     2005      !$OMP BARRIER
     2006    ENDIF ! debutphy
     2007
     2008    !      stop
     2009
     2010    !=======================================================================
     2011
     2012    DO itr = 1, nbtr
     2013      DO j = 1, klev
     2014        DO i = 1, klon
     2015          tmp_var(i, j) = tr_seri(i, j, itr)
     2016        ENDDO
     2017      ENDDO
     2018      CALL kg_to_cm3(pplay, t_seri, tmp_var)
     2019      DO j = 1, klev
     2020        DO i = 1, klon
     2021          tr_seri(i, j, itr) = tmp_var(i, j)
     2022        ENDDO
     2023      ENDDO
     2024    ENDDO
     2025    iscm3 = .true.
     2026
     2027    !=======================================================================
     2028
     2029    DO k = 1, klev
     2030      DO i = 1, klon
     2031        m_conc(i, k) = pplay(i, k) / t_seri(i, k) / RKBOL * 1.e-6
     2032      ENDDO
     2033    ENDDO
     2034
     2035    IF (lminmax) THEN
     2036      DO itr = 1, nbtr
     2037        CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_avt_coarem')
     2038      ENDDO
     2039      DO itr = 1, nbtr
     2040        CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'avt coarem')
     2041      ENDDO
     2042      CALL minmaxsource(source_tr, qmin, qmax, 'src: avt coarem')
     2043    ENDIF
     2044
     2045    IF (logitime) THEN
     2046      CALL SYSTEM_CLOCK(COUNT = clock_end)
     2047      dife = clock_end - clock_start
     2048      ti_inittwrite = dife * MAX(0, SIGN(1, dife))  &
     2049              + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     2050      tia_inittwrite = tia_inittwrite + REAL(ti_inittwrite) / REAL(clock_rate)
     2051    ENDIF
     2052
     2053
     2054    !=======================================================================
     2055    !                     EMISSIONS OF COARSE AEROSOLS
     2056    !=======================================================================
     2057
     2058    IF (logitime) THEN
     2059      CALL SYSTEM_CLOCK(COUNT = clock_start)
     2060    ENDIF
     2061
     2062    print *, 'Number of tracers = ', nbtr
     2063
     2064    print *, 'AT BEGINNING OF PHYTRACR_SPL'
     2065    !      print *,'tr_seri = ',SUM(tr_seri(:,:,3)),MINVAL(tr_seri(:,:,3)),
     2066    !     .                                         MAXVAL(tr_seri(:,:,3))
    21312067#ifdef IOPHYS_DUST
    21322068      do itr=1,nbtr
    … …  
    21422078
    21432079
    2144       CALL coarsemission(pctsrf,pdtphys,t_seri,                            &
    2145                         pmflxr,pmflxs,prfl,psfl,                          &
    2146                         rlat,rlon,debutphy,                                &
    2147                         zu10m,zv10m,wstar,ale_bl,ale_wake,                &
    2148                         scale_param_ssacc,scale_param_sscoa,               &
    2149                         scale_param_dustacc,scale_param_dustcoa,          &
    2150                         scale_param_dustsco,                               &
    2151                         nbreg_dust,                                        &
    2152                         iregion_dust,dust_ec,                              &
    2153                         param_wstarBLperregion,param_wstarWAKEperregion,  &
    2154                         nbreg_wstardust,                                  &
    2155                         iregion_wstardust,                                &
    2156                         lmt_sea_salt,qmin,qmax,                            &
    2157                                   flux_sparam_ddfine,flux_sparam_ddcoa,    &
    2158                                   flux_sparam_ddsco,                      &
    2159                                   flux_sparam_ssfine,flux_sparam_sscoa,    &
    2160                               id_prec,id_fine,id_coss,id_codu,id_scdu,    &
    2161                               ok_chimeredust,                          &
    2162                                                      source_tr,flux_tr)   
     2080    CALL coarsemission(pctsrf, pdtphys, t_seri, &
     2081            pmflxr, pmflxs, prfl, psfl, &
     2082            rlat, rlon, debutphy, &
     2083            zu10m, zv10m, wstar, ale_bl, ale_wake, &
     2084            scale_param_ssacc, scale_param_sscoa, &
     2085            scale_param_dustacc, scale_param_dustcoa, &
     2086            scale_param_dustsco, &
     2087            nbreg_dust, &
     2088            iregion_dust, dust_ec, &
     2089            param_wstarBLperregion, param_wstarWAKEperregion, &
     2090            nbreg_wstardust, &
     2091            iregion_wstardust, &
     2092            lmt_sea_salt, qmin, qmax, &
     2093            flux_sparam_ddfine, flux_sparam_ddcoa, &
     2094            flux_sparam_ddsco, &
     2095            flux_sparam_ssfine, flux_sparam_sscoa, &
     2096            id_prec, id_fine, id_coss, id_codu, id_scdu, &
     2097            ok_chimeredust, &
     2098            source_tr, flux_tr)
    21632099
    21642100#ifdef IOPHYS_DUST
    … …  
    21702106#endif
    21712107
    2172       IF (lminmax) THEN
    2173         DO itr=1,nbtr
    2174         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_after_coarem')
    2175         ENDDO
    2176         DO itr=1,nbtr
    2177         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'after coarem')
    2178         ENDDO
    2179         CALL minmaxsource(source_tr,qmin,qmax,'src: after coarem')
    2180       ENDIF
    2181 
    2182 !
    2183 !
    2184 !
    2185 !======================================================================
    2186 !                   EMISSIONS OF AEROSOL PRECURSORS     
    2187 !======================================================================
    2188 !
     2108    IF (lminmax) THEN
     2109      DO itr = 1, nbtr
     2110        CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_coarem')
     2111      ENDDO
     2112      DO itr = 1, nbtr
     2113        CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after coarem')
     2114      ENDDO
     2115      CALL minmaxsource(source_tr, qmin, qmax, 'src: after coarem')
     2116    ENDIF
     2117
     2118
     2119
     2120    !======================================================================
     2121    !                   EMISSIONS OF AEROSOL PRECURSORS
     2122    !======================================================================
     2123
    21892124#ifdef IOPHYS_DUST
    21902125      print *,'INPUT TO PRECUREMISSION'
    … …  
    22292164
    22302165
    2231      print*,'ON PASSE DANS precuremission'
    2232      CALL precuremission(ftsol,u10m_ec,v10m_ec,pctsrf,                  &
    2233                          u_seri,v_seri,paprs,pplay,cdragh,cdragm,      &
    2234                          t_seri,q_seri,tsol,fracso2emis,frach2sofso2,  &
    2235                          bateau,zdz,zalt,kminbc,kmaxbc,pdtphys,        &
    2236                          scale_param_bb,scale_param_ind,                &
    2237                          iregion_ind, iregion_bb,                      &
    2238                          nbreg_ind, nbreg_bb,                          &
    2239                          lmt_so2ff_l,lmt_so2ff_h, lmt_so2nff,lmt_so2ba, &
    2240                          lmt_so2bb_l,lmt_so2bb_h,                      &
    2241                          lmt_so2volc_cont,lmt_altvolc_cont,            &
    2242                          lmt_so2volc_expl,lmt_altvolc_expl,            &
    2243                          lmt_dmsbio,lmt_h2sbio, lmt_dmsconc, lmt_dms,  &
    2244                          id_prec,id_fine,                              &
    2245                                        flux_sparam_ind, flux_sparam_bb, &
    2246                                        source_tr,flux_tr,tr_seri)       
    2247 !
    2248       IF (lminmax) THEN
    2249         DO itr=1,nbtr
    2250         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_after precur')
    2251         ENDDO
    2252         DO itr=1,nbtr
    2253         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'after precur')
    2254         ENDDO
    2255         CALL minmaxsource(source_tr,qmin,qmax,'src: after precur')
    2256       ENDIF
    2257 
    2258 !=======================================================================
    2259 !                      EMISSIONS OF FINE AEROSOLS
    2260 !=======================================================================
     2166    print*, 'ON PASSE DANS precuremission'
     2167    CALL precuremission(ftsol, u10m_ec, v10m_ec, pctsrf, &
     2168            u_seri, v_seri, paprs, pplay, cdragh, cdragm, &
     2169            t_seri, q_seri, tsol, fracso2emis, frach2sofso2, &
     2170            bateau, zdz, zalt, kminbc, kmaxbc, pdtphys, &
     2171            scale_param_bb, scale_param_ind, &
     2172            iregion_ind, iregion_bb, &
     2173            nbreg_ind, nbreg_bb, &
     2174            lmt_so2ff_l, lmt_so2ff_h, lmt_so2nff, lmt_so2ba, &
     2175            lmt_so2bb_l, lmt_so2bb_h, &
     2176            lmt_so2volc_cont, lmt_altvolc_cont, &
     2177            lmt_so2volc_expl, lmt_altvolc_expl, &
     2178            lmt_dmsbio, lmt_h2sbio, lmt_dmsconc, lmt_dms, &
     2179            id_prec, id_fine, &
     2180            flux_sparam_ind, flux_sparam_bb, &
     2181            source_tr, flux_tr, tr_seri)
     2182
     2183    IF (lminmax) THEN
     2184      DO itr = 1, nbtr
     2185        CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after precur')
     2186      ENDDO
     2187      DO itr = 1, nbtr
     2188        CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after precur')
     2189      ENDDO
     2190      CALL minmaxsource(source_tr, qmin, qmax, 'src: after precur')
     2191    ENDIF
     2192
     2193    !=======================================================================
     2194    !                      EMISSIONS OF FINE AEROSOLS
     2195    !=======================================================================
    22612196#ifdef IOPHYS_DUST
    2262 !
     2197
    22632198      do itr=1,nbtr
    22642199         write(str2,'(i2.2)') itr
    … …  
    22682203#endif
    22692204
    2270       CALL finemission(zdz,pdtphys,zalt,kminbc,kmaxbc,                     &
    2271                       scale_param_bb,scale_param_ff,                       &
    2272                       iregion_ind,iregion_bb,                              &
    2273                       nbreg_ind,nbreg_bb,                                  &
    2274                       lmt_bcff, lmt_bcnff, lmt_bcbb_l,lmt_bcbb_h,          &
    2275                       lmt_bcba, lmt_omff, lmt_omnff,                       &
    2276                       lmt_ombb_l, lmt_ombb_h, lmt_omnat, lmt_omba,         &
    2277                       id_fine,                                             &
    2278                                        flux_sparam_bb, flux_sparam_ff,     &
    2279                                              source_tr,flux_tr,tr_seri)     
    2280 !
    2281 !
    2282       IF (lminmax) THEN
    2283         DO itr=1,nbtr
    2284         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_after_fineem')
    2285         ENDDO
    2286         DO itr=1,nbtr
    2287         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'after fineem')
    2288         ENDDO
     2205    CALL finemission(zdz, pdtphys, zalt, kminbc, kmaxbc, &
     2206            scale_param_bb, scale_param_ff, &
     2207            iregion_ind, iregion_bb, &
     2208            nbreg_ind, nbreg_bb, &
     2209            lmt_bcff, lmt_bcnff, lmt_bcbb_l, lmt_bcbb_h, &
     2210            lmt_bcba, lmt_omff, lmt_omnff, &
     2211            lmt_ombb_l, lmt_ombb_h, lmt_omnat, lmt_omba, &
     2212            id_fine, &
     2213            flux_sparam_bb, flux_sparam_ff, &
     2214            source_tr, flux_tr, tr_seri)
     2215
     2216    IF (lminmax) THEN
     2217      DO itr = 1, nbtr
     2218        CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_fineem')
     2219      ENDDO
     2220      DO itr = 1, nbtr
     2221        CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after fineem')
     2222      ENDDO
    22892223      IF (lcheckmass) THEN
    2290         DO itr=1,nbtr
    2291          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,  &
    2292            pplay,t_seri,iscm3,'after fineem')                 
     2224        DO itr = 1, nbtr
     2225          CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     2226                  pplay, t_seri, iscm3, 'after fineem')
    22932227        ENDDO
    22942228      ENDIF
    2295         CALL minmaxsource(source_tr,qmin,qmax,'src: after fineem')
    2296       ENDIF
    2297 
    2298 !
    2299 
    2300       IF (logitime) THEN
    2301       CALL SYSTEM_CLOCK(COUNT=clock_end)
    2302       dife=clock_end-clock_start
    2303       ti_emis=dife*MAX(0,SIGN(1,dife))   &
    2304       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    2305       tia_emis=tia_emis+REAL(ti_emis)/REAL(clock_rate)
    2306       ENDIF
     2229      CALL minmaxsource(source_tr, qmin, qmax, 'src: after fineem')
     2230    ENDIF
     2231
     2232    IF (logitime) THEN
     2233      CALL SYSTEM_CLOCK(COUNT = clock_end)
     2234      dife = clock_end - clock_start
     2235      ti_emis = dife * MAX(0, SIGN(1, dife))   &
     2236              + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     2237      tia_emis = tia_emis + REAL(ti_emis) / REAL(clock_rate)
     2238    ENDIF
    23072239
    23082240
    … …  
    23142246      enddo
    23152247#endif
    2316 !
    2317 !
    2318 
    2319 
    2320 
    2321 !
    2322 !=======================================================================
    2323 !                 DRY DEPOSITION AND BOUNDARY LAYER MIXING
    2324 !=======================================================================
    2325 !
    2326 !        DO itr=1,nbtr
    2327 !         CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,
    2328 !     .      pplay,t_seri,iscm3,'')
    2329 !        ENDDO
    2330 
    2331 !======================================================================
    2332 !    -- Dry deposition --
    2333 !======================================================================
    2334       IF (logitime) THEN
    2335       CALL SYSTEM_CLOCK(COUNT=clock_start)
     2248
     2249
     2250    !=======================================================================
     2251    !                 DRY DEPOSITION AND BOUNDARY LAYER MIXING
     2252    !=======================================================================
     2253
     2254    !        DO itr=1,nbtr
     2255    !         CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,
     2256    !     .      pplay,t_seri,iscm3,'')
     2257    !        ENDDO
     2258
     2259    !======================================================================
     2260    !    -- Dry deposition --
     2261    !======================================================================
     2262    IF (logitime) THEN
     2263      CALL SYSTEM_CLOCK(COUNT = clock_start)
     2264    ENDIF
     2265
     2266    DO itr = 1, nbtr
     2267      DO j = 1, klev
     2268        DO i = 1, klon
     2269          tmp_var(i, j) = tr_seri(i, j, itr)
     2270        ENDDO
     2271      ENDDO
     2272      CALL cm3_to_kg(pplay, t_seri, tmp_var)
     2273      DO j = 1, klev
     2274        DO i = 1, klon
     2275          tr_seri(i, j, itr) = tmp_var(i, j)
     2276        ENDDO
     2277      ENDDO
     2278    ENDDO
     2279    iscm3 = .false.
     2280    !----------------------------
     2281    IF (lminmax) THEN
     2282      DO itr = 1, nbtr
     2283        CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_depo')
     2284      ENDDO
     2285      DO itr = 1, nbtr
     2286        CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before depo')
     2287      ENDDO
     2288      IF (lcheckmass) THEN
     2289        DO itr = 1, nbtr
     2290          CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     2291                  pplay, t_seri, iscm3, 'before depo')
     2292        ENDDO
    23362293      ENDIF
    2337 
    2338       DO itr=1,nbtr
    2339          DO j=1,klev
    2340          DO i=1,klon
    2341            tmp_var(i,j)=tr_seri(i,j,itr)
    2342          ENDDO
    2343          ENDDO
    2344          CALL cm3_to_kg(pplay,t_seri,tmp_var)
    2345          DO j=1,klev
    2346          DO i=1,klon
    2347            tr_seri(i,j,itr)=tmp_var(i,j)
    2348          ENDDO
    2349          ENDDO
    2350       ENDDO
    2351       iscm3=.false.
    2352 !----------------------------
    2353       IF (lminmax) THEN
    2354         DO itr=1,nbtr
    2355         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_before_depo')
    2356         ENDDO
    2357         DO itr=1,nbtr
    2358         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'before depo')
    2359         ENDDO
    2360       IF (lcheckmass) THEN
    2361         DO itr=1,nbtr
    2362          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz, &
    2363            pplay,t_seri,iscm3,'before depo')
    2364         ENDDO
    2365       ENDIF
    2366         CALL minmaxsource(source_tr,qmin,qmax,'src: before depo')
    2367       ENDIF
     2294      CALL minmaxsource(source_tr, qmin, qmax, 'src: before depo')
     2295    ENDIF
    23682296
    23692297#ifdef IOPHYS_DUST
    … …  
    23742302#endif
    23752303
    2376       CALL deposition(vdep_oce,vdep_sic,vdep_ter,vdep_lic,pctsrf,      &
    2377                      zrho,zdz,pdtphys,RHcl,masse,t_seri,pplay,paprs, &
    2378                      lminmax,qmin,qmax,                              &
    2379                               his_ds,source_tr,tr_seri)
    2380 !
    2381       IF (lminmax) THEN
    2382         DO itr=1,nbtr
    2383         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_after_depo')
    2384         ENDDO
    2385         DO itr=1,nbtr
    2386         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'after depo')
    2387         ENDDO
     2304    CALL deposition(vdep_oce, vdep_sic, vdep_ter, vdep_lic, pctsrf, &
     2305            zrho, zdz, pdtphys, RHcl, masse, t_seri, pplay, paprs, &
     2306            lminmax, qmin, qmax, &
     2307            his_ds, source_tr, tr_seri)
     2308
     2309    IF (lminmax) THEN
     2310      DO itr = 1, nbtr
     2311        CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_depo')
     2312      ENDDO
     2313      DO itr = 1, nbtr
     2314        CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after depo')
     2315      ENDDO
    23882316      IF (lcheckmass) THEN
    2389         DO itr=1,nbtr
    2390          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,  &
    2391            pplay,t_seri,iscm3,'after depo')
     2317        DO itr = 1, nbtr
     2318          CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     2319                  pplay, t_seri, iscm3, 'after depo')
    23922320        ENDDO
    23932321      ENDIF
    2394         CALL minmaxsource(source_tr,qmin,qmax,'src: after depo')
    2395       ENDIF
    2396 
    2397       IF (logitime) THEN
    2398       CALL SYSTEM_CLOCK(COUNT=clock_end)
    2399       dife=clock_end-clock_start
    2400       ti_depo=dife*MAX(0,SIGN(1,dife))                      &
    2401       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    2402       tia_depo=tia_depo+REAL(ti_depo)/REAL(clock_rate)
    2403       ENDIF
    2404 
    2405 
    2406 !
    2407 !======================================================================
    2408 !    -- Boundary layer mixing --
    2409 !======================================================================
     2322      CALL minmaxsource(source_tr, qmin, qmax, 'src: after depo')
     2323    ENDIF
     2324
     2325    IF (logitime) THEN
     2326      CALL SYSTEM_CLOCK(COUNT = clock_end)
     2327      dife = clock_end - clock_start
     2328      ti_depo = dife * MAX(0, SIGN(1, dife))                      &
     2329              + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     2330      tia_depo = tia_depo + REAL(ti_depo) / REAL(clock_rate)
     2331    ENDIF
     2332
     2333    !======================================================================
     2334    !    -- Boundary layer mixing --
     2335    !======================================================================
    24102336
    24112337#ifdef IOPHYS_DUST
    … …  
    24182344
    24192345
    2420       IF (logitime) THEN
    2421       CALL SYSTEM_CLOCK(COUNT=clock_start)
     2346    IF (logitime) THEN
     2347      CALL SYSTEM_CLOCK(COUNT = clock_start)
     2348    ENDIF
     2349
     2350    DO k = 1, klev
     2351      DO i = 1, klon
     2352        delp(i, k) = paprs(i, k) - paprs(i, k + 1)
     2353      END DO
     2354    END DO
     2355
     2356    DO itr = 1, nbtr
     2357      DO j = 1, klev
     2358        DO i = 1, klon
     2359          tmp_var(i, j) = tr_seri(i, j, itr)
     2360          aux_var2(i) = source_tr(i, itr)
     2361        ENDDO
     2362      ENDDO
     2363      IF (iflag_conv==2) THEN
     2364        ! Tiedke
     2365        CALL cltrac_spl(pdtphys, coefh, yu1, yv1, t_seri, tmp_var, &
     2366                aux_var2, paprs, pplay, aux_var3)
     2367
     2368      ELSE IF (iflag_conv>=3) THEN
     2369        !KE
     2370        CALL cltrac(pdtphys, coefh, t_seri, tmp_var, aux_var2, paprs, pplay, &
     2371                delp, aux_var3, d_tr_dry, flux_tr_dry(:, itr))
    24222372      ENDIF
    24232373
    2424 !
    2425 
    2426        DO k = 1, klev
     2374      DO i = 1, klon
     2375        DO j = 1, klev
     2376          tr_seri(i, j, itr) = tmp_var(i, j)
     2377          d_tr(i, j, itr) = aux_var3(i, j)
     2378          d_tr_cl(i, j, itr) = d_tr(i, j, itr)
     2379        ENDDO
     2380      ENDDO
     2381      DO k = 1, klev
    24272382        DO i = 1, klon
    2428          delp(i,k) = paprs(i,k)-paprs(i,k+1)
    2429         END DO
    2430       END DO
    2431 !
    2432       DO itr=1,nbtr
    2433       DO j=1, klev
    2434       DO i=1, klon
    2435         tmp_var(i,j)=tr_seri(i,j,itr)
    2436         aux_var2(i)=source_tr(i,itr)
    2437       ENDDO
    2438       ENDDO
    2439       IF (iflag_conv==2) THEN
    2440 ! Tiedke
    2441       CALL cltrac_spl(pdtphys,coefh,yu1,yv1,t_seri,tmp_var,  &
    2442                  aux_var2,paprs,pplay,aux_var3)
    2443 
    2444       ELSE IF (iflag_conv>=3) THEN
    2445 !KE
    2446       CALL cltrac(pdtphys, coefh,t_seri,tmp_var,aux_var2,paprs,pplay,  &
    2447                  delp,aux_var3,d_tr_dry,flux_tr_dry(:,itr))
     2383          tr_seri(i, k, itr) = tr_seri(i, k, itr) + d_tr(i, k, itr)
     2384        ENDDO
     2385      ENDDO
     2386      print *, ' AFTER Cltrac'
     2387      IF (lminmax) THEN
     2388        CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after cltrac')
    24482389      ENDIF
    2449 
    2450       DO i=1, klon
    2451       DO j=1, klev
    2452         tr_seri(i,j,itr)=tmp_var(i,j)
    2453         d_tr(i,j,itr)=aux_var3(i,j)
    2454         d_tr_cl(i,j,itr)=d_tr(i,j,itr)
    2455       ENDDO
    2456       ENDDO
    2457       DO k = 1, klev
    2458       DO i = 1, klon
    2459          tr_seri(i,k,itr) = tr_seri(i,k,itr) + d_tr(i,k,itr)
    2460       ENDDO
    2461       ENDDO
    2462       print *,' AFTER Cltrac'
    2463       IF (lminmax) THEN
    2464         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'after cltrac')
    2465       ENDIF
    2466       ENDDO !--end itr loop
    2467 
    2468       IF (logitime) THEN
    2469       CALL SYSTEM_CLOCK(COUNT=clock_end)
    2470       dife=clock_end-clock_start
    2471       ti_cltr=dife*MAX(0,SIGN(1,dife))     &
    2472       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    2473       tia_cltr=tia_cltr+REAL(ti_cltr)/REAL(clock_rate)
    2474       ENDIF
    2475 
    2476 
    2477 
    2478 !======================================================================
    2479 !    -- Calcul de l'effet des thermiques for KE--
    2480 !======================================================================
     2390    ENDDO !--end itr loop
     2391
     2392    IF (logitime) THEN
     2393      CALL SYSTEM_CLOCK(COUNT = clock_end)
     2394      dife = clock_end - clock_start
     2395      ti_cltr = dife * MAX(0, SIGN(1, dife))     &
     2396              + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     2397      tia_cltr = tia_cltr + REAL(ti_cltr) / REAL(clock_rate)
     2398    ENDIF
     2399
     2400
     2401
     2402    !======================================================================
     2403    !    -- Calcul de l'effet des thermiques for KE--
     2404    !======================================================================
    24812405
    24822406#ifdef IOPHYS_DUST
    … …  
    24942418
    24952419
    2496       IF (iflag_conv>=3) THEN
     2420    IF (iflag_conv>=3) THEN
    24972421
    24982422      IF (logitime) THEN
    2499       CALL SYSTEM_CLOCK(COUNT=clock_start)
     2423        CALL SYSTEM_CLOCK(COUNT = clock_start)
    25002424      ENDIF
    25012425
    2502 
    2503 
    2504 
    2505      
    2506        IF (lminmax) THEN
    2507         DO itr=1,nbtr
    2508        CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_before therm')
    2509         ENDDO
    2510         DO itr=1,nbtr
    2511         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'before therm')
    2512         ENDDO
     2426      IF (lminmax) THEN
     2427        DO itr = 1, nbtr
     2428          CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before therm')
     2429        ENDDO
     2430        DO itr = 1, nbtr
     2431          CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before therm')
     2432        ENDDO
     2433        IF (lcheckmass) THEN
     2434          DO itr = 1, nbtr
     2435            CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     2436                    pplay, t_seri, iscm3, 'before therm')
     2437          ENDDO
     2438        ENDIF
     2439        CALL minmaxsource(source_tr, qmin, qmax, 'before therm')
     2440      ENDIF
     2441
     2442      DO itr = 1, nbtr
     2443        DO k = 1, klev
     2444          DO i = 1, klon
     2445            tmp_var3(i, k, itr) = tr_seri(i, k, itr)
     2446            d_tr_th(i, k, itr) = 0.
     2447            tr_seri(i, k, itr) = MAX(tr_seri(i, k, itr), 0.)
     2448            !JE: precursor >>1e10         tr_seri(i,k,itr)=MIN(tr_seri(i,k,itr),1.e10)
     2449          END DO
     2450        END DO
     2451      END DO
     2452
     2453      !JE  new implicit scheme 20140323
     2454      DO itr = 1, nbtr
     2455        CALL thermcell_dq(klon, klev, 1, pdtphys, fm_therm, entr_therm, &
     2456                zmasse, tr_seri(1:klon, 1:klev, itr), &
     2457                d_tr(1:klon, 1:klev, itr), ztra_th, 0)
     2458
     2459        DO k = 1, klev
     2460          DO i = 1, klon
     2461            d_tr(i, k, itr) = pdtphys * d_tr(i, k, itr)
     2462            d_tr_th(i, k, itr) = d_tr_th(i, k, itr) + d_tr(i, k, itr)
     2463            tr_seri(i, k, itr) = MAX(tr_seri(i, k, itr) + d_tr(i, k, itr), 0.)
     2464          END DO
     2465        END DO
     2466
     2467      ENDDO
     2468
     2469      ! old scheme explicit
     2470      !       nsplit=10
     2471      !       DO itr=1,nbtr
     2472      !          DO isplit=1,nsplit
     2473      !              CALL dqthermcell(klon,klev,pdtphys/nsplit,
     2474      !     .            fm_therm,entr_therm,zmasse,
     2475      !     .            tr_seri(1:klon,1:klev,itr),
     2476      !     .            d_tr(1:klon,1:klev,itr),ztra_th)
     2477      !            DO k=1,klev
     2478      !               DO i=1,klon
     2479      !                  d_tr(i,k,itr)=pdtphys*d_tr(i,k,itr)/nsplit
     2480      !                  d_tr_th(i,k,itr)=d_tr_th(i,k,itr)+d_tr(i,k,itr)
     2481      !                  tr_seri(i,k,itr)=MAX(tr_seri(i,k,itr)+d_tr(i,k,itr),0.)
     2482      !               END DO
     2483      !            END DO
     2484      !         END DO ! nsplit1
     2485      !      END DO ! it
     2486      !JE end modif 20140323
     2487
     2488      DO itr = 1, nbtr
     2489        DO k = 1, klev
     2490          DO i = 1, klon
     2491            tmp_var(i, k) = tr_seri(i, k, itr) - tmp_var3(i, k, itr)
     2492          ENDDO
     2493        ENDDO
     2494        IF (lminmax) THEN
     2495          IF (lcheckmass) THEN
     2496            CALL checkmass(tmp_var(:, :), RNAVO, masse(itr), zdz, &
     2497                    pplay, t_seri, iscm3, 'dtr therm ')
     2498          ENDIF
     2499        ENDIF
     2500        CALL kg_to_cm3(pplay, t_seri, tmp_var)
     2501
     2502        DO k = 1, klev
     2503          DO i = 1, klon
     2504            his_th(i, itr) = his_th(i, itr) + &
     2505                    (tmp_var(i, k)) / RNAVO * &
     2506                            masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     2507          END DO !klon
     2508        END DO !klev
     2509
     2510      END DO !it
     2511      IF (lminmax) THEN
     2512        DO itr = 1, nbtr
     2513          CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after therm')
     2514        ENDDO
     2515        DO itr = 1, nbtr
     2516          CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after therm')
     2517        ENDDO
     2518        IF (lcheckmass) THEN
     2519          DO itr = 1, nbtr
     2520            CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     2521                    pplay, t_seri, iscm3, 'after therm')
     2522          ENDDO
     2523        ENDIF
     2524        CALL minmaxsource(source_tr, qmin, qmax, 'after therm')
     2525      ENDIF
     2526
     2527      IF (logitime) THEN
     2528        CALL SYSTEM_CLOCK(COUNT = clock_end)
     2529        dife = clock_end - clock_start
     2530        ti_ther = dife * MAX(0, SIGN(1, dife))   &
     2531                + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     2532        tia_ther = tia_ther + REAL(ti_ther) / REAL(clock_rate)
     2533      ENDIF
     2534
     2535    ENDIF ! iflag_conv KE
     2536    !------------------------------------
     2537    !      Sedimentation
     2538    !-----------------------------------
     2539    IF (logitime) THEN
     2540      CALL SYSTEM_CLOCK(COUNT = clock_start)
     2541    ENDIF
     2542
     2543    DO itr = 1, nbtr
     2544      DO j = 1, klev
     2545        DO i = 1, klon
     2546          tmp_var(i, j) = tr_seri(i, j, itr)
     2547        ENDDO
     2548      ENDDO
     2549      CALL kg_to_cm3(pplay, t_seri, tmp_var)
     2550      DO j = 1, klev
     2551        DO i = 1, klon
     2552          tr_seri(i, j, itr) = tmp_var(i, j)
     2553        ENDDO
     2554      ENDDO
     2555    ENDDO !--end itr loop
     2556    iscm3 = .true.
     2557    !--------------------------------------
     2558    print *, ' BEFORE Sediment'
     2559
     2560    IF (lminmax) THEN
     2561      DO itr = 1, nbtr
     2562        CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_sedi')
     2563      ENDDO
     2564      DO itr = 1, nbtr
     2565        CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before sedi')
     2566      ENDDO
    25132567      IF (lcheckmass) THEN
    2514         DO itr=1,nbtr
    2515          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz, &
    2516            pplay,t_seri,iscm3,'before therm')
     2568        DO itr = 1, nbtr
     2569          CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     2570                  pplay, t_seri, iscm3, 'before sedi')
    25172571        ENDDO
    25182572      ENDIF
    2519         CALL minmaxsource(source_tr,qmin,qmax,'before therm')
     2573      CALL minmaxsource(source_tr, qmin, qmax, 'src: before sedi')
     2574    ENDIF
     2575
     2576    print *, 'SPLA VERSION OF SEDIMENTATION IS USED'
     2577    CALL sediment_mod(t_seri, pplay, zrho, paprs, pdtphys, RHcl, &
     2578            id_coss, id_codu, id_scdu, &
     2579            ok_chimeredust, &
     2580            sed_ss, sed_dust, sed_dustsco, &
     2581            sed_ss3D, sed_dust3D, sed_dustsco3D, tr_seri)
     2582    CALL cm3_to_kg(pplay, t_seri, sed_ss3D)
     2583    CALL cm3_to_kg(pplay, t_seri, sed_dust3D)
     2584    CALL cm3_to_kg(pplay, t_seri, sed_dustsco3D)
     2585
     2586    IF (lminmax) THEN
     2587      DO itr = 1, nbtr
     2588        CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_sedi')
     2589      ENDDO
     2590      DO itr = 1, nbtr
     2591        CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after sedi')
     2592      ENDDO
     2593      IF (lcheckmass) THEN
     2594        DO itr = 1, nbtr
     2595          CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     2596                  pplay, t_seri, iscm3, 'after sedi')
     2597        ENDDO
    25202598      ENDIF
    2521 
    2522       DO itr=1,nbtr
    2523          DO k=1,klev
    2524             DO i=1,klon
    2525                tmp_var3(i,k,itr)=tr_seri(i,k,itr)
    2526                d_tr_th(i,k,itr)=0.
    2527                tr_seri(i,k,itr)=MAX(tr_seri(i,k,itr),0.)
    2528 !JE: precursor >>1e10         tr_seri(i,k,itr)=MIN(tr_seri(i,k,itr),1.e10)
    2529             END DO
    2530          END DO
    2531       END DO
    2532 
    2533 !JE  new implicit scheme 20140323
    2534       DO itr=1,nbtr
    2535         CALL thermcell_dq(klon,klev,1,pdtphys,fm_therm,entr_therm,  &
    2536                          zmasse,tr_seri(1:klon,1:klev,itr),         &
    2537                          d_tr(1:klon,1:klev,itr),ztra_th,0 )
    2538 
    2539         DO k=1,klev
    2540            DO i=1,klon
    2541               d_tr(i,k,itr)=pdtphys*d_tr(i,k,itr)
    2542               d_tr_th(i,k,itr)=d_tr_th(i,k,itr)+d_tr(i,k,itr)
    2543               tr_seri(i,k,itr)=MAX(tr_seri(i,k,itr)+d_tr(i,k,itr),0.)
    2544               END DO
    2545         END DO
    2546 
    2547       ENDDO
    2548 
    2549 ! old scheme explicit
    2550 !       nsplit=10
    2551 !       DO itr=1,nbtr
    2552 !          DO isplit=1,nsplit
    2553 !              CALL dqthermcell(klon,klev,pdtphys/nsplit,
    2554 !     .            fm_therm,entr_therm,zmasse,
    2555 !     .            tr_seri(1:klon,1:klev,itr),
    2556 !     .            d_tr(1:klon,1:klev,itr),ztra_th)
    2557 !            DO k=1,klev
    2558 !               DO i=1,klon
    2559 !                  d_tr(i,k,itr)=pdtphys*d_tr(i,k,itr)/nsplit
    2560 !                  d_tr_th(i,k,itr)=d_tr_th(i,k,itr)+d_tr(i,k,itr)
    2561 !                  tr_seri(i,k,itr)=MAX(tr_seri(i,k,itr)+d_tr(i,k,itr),0.)
    2562 !               END DO
    2563 !            END DO
    2564 !         END DO ! nsplit1
    2565 !      END DO ! it
    2566 !JE end modif 20140323
    2567 
    2568       DO itr=1,nbtr
    2569          DO k=1,klev
    2570             DO i=1,klon
    2571           tmp_var(i,k)=tr_seri(i,k,itr)-tmp_var3(i,k,itr)
    2572             ENDDO
    2573          ENDDO
    2574        IF (lminmax) THEN
    2575       IF (lcheckmass) THEN
    2576          CALL checkmass(tmp_var(:,:),RNAVO,masse(itr),zdz,  &
    2577            pplay,t_seri,iscm3,'dtr therm ')
    2578       ENDIF
    2579        ENDIF
    2580          CALL kg_to_cm3(pplay,t_seri,tmp_var)
    2581 
    2582          DO k=1,klev
    2583             DO i=1,klon
    2584                his_th(i,itr)=his_th(i,itr)+    &
    2585                            (tmp_var(i,k))/RNAVO*   &
    2586                      masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys
    2587             END DO !klon
    2588          END DO !klev
    2589 
    2590       END DO !it
    2591        IF (lminmax) THEN
    2592         DO itr=1,nbtr
    2593        CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_after therm')
    2594         ENDDO
    2595         DO itr=1,nbtr
    2596         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'after therm')
    2597         ENDDO
    2598       IF (lcheckmass) THEN
    2599         DO itr=1,nbtr
    2600          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,   &
    2601            pplay,t_seri,iscm3,'after therm')
    2602         ENDDO
    2603       ENDIF
    2604         CALL minmaxsource(source_tr,qmin,qmax,'after therm')
    2605        ENDIF
    2606 
    2607       IF (logitime) THEN
    2608       CALL SYSTEM_CLOCK(COUNT=clock_end)
    2609       dife=clock_end-clock_start
    2610       ti_ther=dife*MAX(0,SIGN(1,dife))   &
    2611       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    2612       tia_ther=tia_ther+REAL(ti_ther)/REAL(clock_rate)
    2613       ENDIF
    2614 
    2615 
    2616       ENDIF ! iflag_conv KE
    2617 !------------------------------------
    2618 !      Sedimentation
    2619 !-----------------------------------
    2620       IF (logitime) THEN
    2621       CALL SYSTEM_CLOCK(COUNT=clock_start)
    2622       ENDIF
    2623 
    2624 
    2625       DO itr=1,nbtr
    2626       DO j=1,klev
    2627       DO i=1,klon
    2628          tmp_var(i,j)=tr_seri(i,j,itr)
    2629       ENDDO
    2630       ENDDO
    2631       CALL kg_to_cm3(pplay,t_seri,tmp_var)
    2632       DO j=1,klev
    2633       DO i=1,klon
    2634          tr_seri(i,j,itr)=tmp_var(i,j)
    2635       ENDDO
    2636       ENDDO
    2637       ENDDO !--end itr loop
    2638       iscm3=.true.
    2639 !--------------------------------------
    2640       print *,' BEFORE Sediment'
    2641 
    2642       IF (lminmax) THEN
    2643         DO itr=1,nbtr
    2644         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_before_sedi')
    2645         ENDDO
    2646         DO itr=1,nbtr
    2647         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'before sedi')
    2648         ENDDO
    2649       IF (lcheckmass) THEN
    2650         DO itr=1,nbtr
    2651          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,   &
    2652            pplay,t_seri,iscm3,'before sedi')
    2653         ENDDO
    2654       ENDIF
    2655         CALL minmaxsource(source_tr,qmin,qmax,'src: before sedi')
    2656       ENDIF
    2657 
    2658       print *,'SPLA VERSION OF SEDIMENTATION IS USED'
    2659       CALL sediment_mod(t_seri,pplay,zrho,paprs,pdtphys,RHcl,   &
    2660                                      id_coss,id_codu,id_scdu,  &
    2661                                      ok_chimeredust,           &
    2662                          sed_ss,sed_dust,sed_dustsco,          &
    2663                          sed_ss3D,sed_dust3D,sed_dustsco3D,tr_seri)
    2664       CALL cm3_to_kg(pplay,t_seri,sed_ss3D)
    2665       CALL cm3_to_kg(pplay,t_seri,sed_dust3D)
    2666       CALL cm3_to_kg(pplay,t_seri,sed_dustsco3D)
    2667 
    2668       IF (lminmax) THEN
    2669         DO itr=1,nbtr
    2670         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_after_sedi')
    2671         ENDDO
    2672         DO itr=1,nbtr
    2673         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'after sedi')
    2674         ENDDO
    2675       IF (lcheckmass) THEN
    2676         DO itr=1,nbtr
    2677          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,  &
    2678            pplay,t_seri,iscm3,'after sedi')
    2679         ENDDO
    2680       ENDIF
    2681         CALL minmaxsource(source_tr,qmin,qmax,'src: after sedi')
    2682       ENDIF
    2683 
    2684 !
    2685 !=======================================================================
     2599      CALL minmaxsource(source_tr, qmin, qmax, 'src: after sedi')
     2600    ENDIF
     2601
     2602    !=======================================================================
    26862603#ifdef IOPHYS_DUST
    26872604      do itr=1,nbtr
    … …  
    26912608#endif
    26922609
    2693 
    2694 
    2695 !
    2696       IF (logitime) THEN
    2697       CALL SYSTEM_CLOCK(COUNT=clock_end)
    2698       dife=clock_end-clock_start
    2699       ti_sedi=dife*MAX(0,SIGN(1,dife))   &
    2700       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    2701       tia_sedi=tia_sedi+REAL(ti_sedi)/REAL(clock_rate)
     2610    IF (logitime) THEN
     2611      CALL SYSTEM_CLOCK(COUNT = clock_end)
     2612      dife = clock_end - clock_start
     2613      ti_sedi = dife * MAX(0, SIGN(1, dife))   &
     2614              + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     2615      tia_sedi = tia_sedi + REAL(ti_sedi) / REAL(clock_rate)
     2616    ENDIF
     2617
     2618    DO itr = 1, nbtr
     2619      DO j = 1, klev
     2620        DO i = 1, klon
     2621          tmp_var(i, j) = tr_seri(i, j, itr)
     2622        ENDDO
     2623      ENDDO
     2624      CALL cm3_to_kg(pplay, t_seri, tmp_var)
     2625      DO j = 1, klev
     2626        DO i = 1, klon
     2627          tr_seri(i, j, itr) = tmp_var(i, j)
     2628        ENDDO
     2629      ENDDO
     2630    ENDDO
     2631    iscm3 = .false.
     2632
     2633
     2634    !======================================================================
     2635    !                      GAS TO PARTICLE CONVERSION
     2636    !======================================================================
     2637
     2638    IF (logitime) THEN
     2639      CALL SYSTEM_CLOCK(COUNT = clock_start)
     2640    ENDIF
     2641
     2642    IF (lminmax) THEN
     2643      DO itr = 1, nbtr
     2644        CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_beforegastopar')
     2645      ENDDO
     2646      DO itr = 1, nbtr
     2647        CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before gastopar')
     2648      ENDDO
     2649      IF (lcheckmass) THEN
     2650        DO itr = 1, nbtr
     2651          CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     2652                  pplay, t_seri, iscm3, 'before gastopar')
     2653        ENDDO
    27022654      ENDIF
    2703 
    2704       DO itr=1,nbtr
    2705          DO j=1,klev
    2706          DO i=1,klon
    2707            tmp_var(i,j)=tr_seri(i,j,itr)
    2708          ENDDO
    2709          ENDDO
    2710          CALL cm3_to_kg(pplay,t_seri,tmp_var)
    2711          DO j=1,klev
    2712          DO i=1,klon
    2713            tr_seri(i,j,itr)=tmp_var(i,j)
    2714          ENDDO
    2715          ENDDO
    2716       ENDDO
    2717       iscm3=.false.
    2718 !
    2719 !
    2720 !======================================================================
    2721 !                      GAS TO PARTICLE CONVERSION     
    2722 !======================================================================
    2723 !
    2724 
    2725       IF (logitime) THEN
    2726       CALL SYSTEM_CLOCK(COUNT=clock_start)
     2655      CALL minmaxsource(source_tr, qmin, qmax, 'src: before gastopar')
     2656    ENDIF
     2657
     2658    CALL gastoparticle(pdtphys, zdz, zrho, rlat, &
     2659            pplay, t_seri, id_prec, id_fine, &
     2660            tr_seri, his_g2pgas, his_g2paer)
     2661
     2662    IF (lminmax) THEN
     2663      DO itr = 1, nbtr
     2664        CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_gastopar')
     2665      ENDDO
     2666      DO itr = 1, nbtr
     2667        CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after gastopar')
     2668      ENDDO
     2669      IF (lcheckmass) THEN
     2670        DO itr = 1, nbtr
     2671          CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     2672                  pplay, t_seri, iscm3, 'after gastopar')
     2673        ENDDO
    27272674      ENDIF
    2728 
    2729       IF (lminmax) THEN
    2730         DO itr=1,nbtr
    2731         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_beforegastopar')
    2732         ENDDO
    2733         DO itr=1,nbtr
    2734         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'before gastopar')
    2735         ENDDO
    2736       IF (lcheckmass) THEN
    2737         DO itr=1,nbtr
    2738          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,  &
    2739            pplay,t_seri,iscm3,'before gastopar')
    2740         ENDDO
    2741       ENDIF
    2742         CALL minmaxsource(source_tr,qmin,qmax,'src: before gastopar')
    2743       ENDIF
    2744 
    2745       CALL gastoparticle(pdtphys,zdz,zrho,rlat, &
    2746                    pplay,t_seri,id_prec,id_fine, &
    2747                    tr_seri,his_g2pgas ,his_g2paer)
    2748 !
    2749       IF (lminmax) THEN
    2750         DO itr=1,nbtr
    2751         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_after_gastopar')
    2752         ENDDO
    2753         DO itr=1,nbtr
    2754         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'after gastopar')
    2755         ENDDO
    2756       IF (lcheckmass) THEN
    2757         DO itr=1,nbtr
    2758          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,  &
    2759            pplay,t_seri,iscm3,'after gastopar')
    2760         ENDDO
    2761        ENDIF
    2762         CALL minmaxsource(source_tr,qmin,qmax,'src: after gastopar')
    2763       ENDIF
    2764 
    2765       IF (logitime) THEN
    2766       CALL SYSTEM_CLOCK(COUNT=clock_end)
    2767       dife=clock_end-clock_start
    2768       ti_gasp=dife*MAX(0,SIGN(1,dife))   &
    2769       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    2770       tia_gasp=tia_gasp+REAL(ti_gasp)/REAL(clock_rate)
    2771       ENDIF
    2772 
    2773 
    2774 !
    2775 !======================================================================
    2776 !          EFFECT OF PRECIPITATION: iflag_conv=2
    2777 !======================================================================
    2778 !
     2675      CALL minmaxsource(source_tr, qmin, qmax, 'src: after gastopar')
     2676    ENDIF
     2677
     2678    IF (logitime) THEN
     2679      CALL SYSTEM_CLOCK(COUNT = clock_end)
     2680      dife = clock_end - clock_start
     2681      ti_gasp = dife * MAX(0, SIGN(1, dife))   &
     2682              + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     2683      tia_gasp = tia_gasp + REAL(ti_gasp) / REAL(clock_rate)
     2684    ENDIF
     2685
     2686    !======================================================================
     2687    !          EFFECT OF PRECIPITATION: iflag_conv=2
     2688    !======================================================================
    27792689
    27802690#ifdef IOPHYS_DUST
    … …  
    27862696
    27872697
    2788       IF (iflag_conv==2) THEN
     2698    IF (iflag_conv==2) THEN
    27892699
    27902700      IF (logitime) THEN
    2791       CALL SYSTEM_CLOCK(COUNT=clock_start)
     2701        CALL SYSTEM_CLOCK(COUNT = clock_start)
    27922702      ENDIF
    27932703
    2794 
    2795 
    2796 
    2797        DO itr=1,nbtr
    2798         DO j=1,klev
    2799         DO i=1,klon
    2800            tmp_var(i,j)=tr_seri(i,j,itr)
    2801         ENDDO
    2802         ENDDO
    2803         CALL kg_to_cm3(pplay,t_seri,tmp_var)
    2804         DO j=1,klev
    2805         DO i=1,klon
    2806            tr_seri(i,j,itr)=tmp_var(i,j)
    2807         ENDDO
    2808         ENDDO
    2809       ENDDO
    2810        iscm3=.true.
    2811 !------------------------------
    2812 
    2813       print *,'iflag_conv bef lessiv',iflag_conv
     2704      DO itr = 1, nbtr
     2705        DO j = 1, klev
     2706          DO i = 1, klon
     2707            tmp_var(i, j) = tr_seri(i, j, itr)
     2708          ENDDO
     2709        ENDDO
     2710        CALL kg_to_cm3(pplay, t_seri, tmp_var)
     2711        DO j = 1, klev
     2712          DO i = 1, klon
     2713            tr_seri(i, j, itr) = tmp_var(i, j)
     2714          ENDDO
     2715        ENDDO
     2716      ENDDO
     2717      iscm3 = .true.
     2718      !------------------------------
     2719
     2720      print *, 'iflag_conv bef lessiv', iflag_conv
    28142721      IF (lessivage) THEN
    2815 !
    2816       print *,' BEFORE Incloud'
    2817 
    2818       IF (lminmax) THEN
    2819         DO itr=1,nbtr
    2820         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_before_incloud')
    2821         ENDDO
    2822         DO itr=1,nbtr
    2823         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'before incloud')
    2824         ENDDO
    2825       IF (lcheckmass) THEN
    2826         DO itr=1,nbtr
    2827          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,  &
    2828            pplay,t_seri,iscm3,'before incloud')
    2829         ENDDO
     2722
     2723        print *, ' BEFORE Incloud'
     2724
     2725        IF (lminmax) THEN
     2726          DO itr = 1, nbtr
     2727            CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_incloud')
     2728          ENDDO
     2729          DO itr = 1, nbtr
     2730            CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before incloud')
     2731          ENDDO
     2732          IF (lcheckmass) THEN
     2733            DO itr = 1, nbtr
     2734              CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     2735                      pplay, t_seri, iscm3, 'before incloud')
     2736            ENDDO
     2737          ENDIF
     2738          CALL minmaxsource(source_tr, qmin, qmax, 'src: before incloud')
     2739        ENDIF
     2740
     2741
     2742        !      CALL incloud_scav(lminmax,qmin,qmax,masse,henry,kk,prfl,
     2743        !     .                  psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,
     2744
     2745        !     .                                     his_dhlsc,his_dhcon,tr_seri)
     2746        print *, 'iflag_conv bef incloud', iflag_conv
     2747
     2748        IF (iflag_conv==2) THEN
     2749          ! Tiedke
     2750          CALL incloud_scav(.false., qmin, qmax, masse, henry, kk, prfl, &
     2751                  psfl, pmflxr, pmflxs, zrho, zdz, t_seri, pdtphys, &
     2752                  his_dhlsc, his_dhcon, tr_seri)
     2753
     2754          !---------- to use this option please comment lsc_scav at the end
     2755          !        ELSE IF (iflag_conv.GE.3) THEN
     2756
     2757          !      CALL incloud_scav_lsc(.false.,qmin,qmax,masse,henry,kk,prfl,
     2758          !     .                  psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,
     2759          !     .                                     his_dhlsc,his_dhcon,tr_seri)
     2760          !--------------------------------------------------------------
     2761
     2762        ENDIF
     2763
     2764        print *, ' BEFORE blcloud (after incloud)'
     2765        IF (lminmax) THEN
     2766          DO itr = 1, nbtr
     2767            CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_blcloud')
     2768          ENDDO
     2769          DO itr = 1, nbtr
     2770            CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before blcloud')
     2771          ENDDO
     2772          IF (lcheckmass) THEN
     2773            DO itr = 1, nbtr
     2774              CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     2775                      pplay, t_seri, iscm3, 'before blcloud')
     2776            ENDDO
     2777          ENDIF
     2778          CALL minmaxsource(source_tr, qmin, qmax, 'src: before blcloud')
     2779        ENDIF
     2780
     2781        !      CALL blcloud_scav(lminmax,qmin,qmax,pdtphys,prfl,psfl,
     2782        !     .                  pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse,
     2783        !     .                                  his_dhbclsc,his_dhbccon,tr_seri)
     2784
     2785        IF (iflag_conv==2) THEN
     2786          ! Tiedke
     2787
     2788          CALL blcloud_scav(.false., qmin, qmax, pdtphys, prfl, psfl, &
     2789                  pmflxr, pmflxs, zdz, alpha_r, alpha_s, masse, &
     2790                  his_dhbclsc, his_dhbccon, tr_seri)
     2791
     2792          !---------- to use this option please comment lsc_scav at the end
     2793          !           and comment IF iflag=2 after "EFFECT OF PRECIPITATION:"
     2794
     2795
     2796          !        ELSE IF (iflag_conv.GE.3) THEN
     2797
     2798          !      CALL blcloud_scav_lsc(.false.,qmin,qmax,pdtphys,prfl,psfl,
     2799          !     .                  pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse,
     2800          !     .                                  his_dhbclsc,his_dhbccon,tr_seri)
     2801
     2802          !----------------------------------------------------------------------
     2803        ENDIF
     2804
     2805        print *, ' AFTER blcloud '
     2806
     2807        IF (lminmax) THEN
     2808          DO itr = 1, nbtr
     2809            CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_blcloud')
     2810          ENDDO
     2811          DO itr = 1, nbtr
     2812            CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after blcloud')
     2813          ENDDO
     2814          IF (lcheckmass) THEN
     2815            DO itr = 1, nbtr
     2816              CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     2817                      pplay, t_seri, iscm3, 'after blcloud')
     2818            ENDDO
     2819          ENDIF
     2820          CALL minmaxsource(source_tr, qmin, qmax, 'src: after blcloud')
     2821        ENDIF
     2822
     2823      ENDIF !--lessivage
     2824
     2825      DO itr = 1, nbtr
     2826        DO j = 1, klev
     2827          DO i = 1, klon
     2828            tmp_var(i, j) = tr_seri(i, j, itr)
     2829          ENDDO
     2830        ENDDO
     2831        CALL cm3_to_kg(pplay, t_seri, tmp_var)
     2832        DO j = 1, klev
     2833          DO i = 1, klon
     2834            tr_seri(i, j, itr) = tmp_var(i, j)
     2835          ENDDO
     2836        ENDDO
     2837      ENDDO
     2838      iscm3 = .false.
     2839
     2840      IF (logitime) THEN
     2841        CALL SYSTEM_CLOCK(COUNT = clock_end)
     2842        dife = clock_end - clock_start
     2843        ti_wetap = dife * MAX(0, SIGN(1, dife))    &
     2844                + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     2845        tia_wetap = tia_wetap + REAL(ti_wetap) / REAL(clock_rate)
    28302846      ENDIF
    2831         CALL minmaxsource(source_tr,qmin,qmax,'src: before incloud')
    2832       ENDIF
    2833 
    2834 
    2835 !      CALL incloud_scav(lminmax,qmin,qmax,masse,henry,kk,prfl,
    2836 !     .                  psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,
    2837 
    2838 !     .                                     his_dhlsc,his_dhcon,tr_seri)
    2839       print *,'iflag_conv bef incloud',iflag_conv
    2840 
    2841         IF (iflag_conv==2) THEN
    2842 ! Tiedke
    2843       CALL incloud_scav(.false.,qmin,qmax,masse,henry,kk,prfl,          &
    2844                        psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,     &
    2845                                           his_dhlsc,his_dhcon,tr_seri)
    2846 
    2847 !---------- to use this option please comment lsc_scav at the end
    2848 !        ELSE IF (iflag_conv.GE.3) THEN
    2849 !
    2850 !      CALL incloud_scav_lsc(.false.,qmin,qmax,masse,henry,kk,prfl,
    2851 !     .                  psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,
    2852 !     .                                     his_dhlsc,his_dhcon,tr_seri)
    2853 !--------------------------------------------------------------
    2854 
    2855         ENDIF
    2856 !
    2857 !
    2858       print *,' BEFORE blcloud (after incloud)'
    2859       IF (lminmax) THEN
    2860         DO itr=1,nbtr
    2861         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_before_blcloud')
    2862         ENDDO
    2863         DO itr=1,nbtr
    2864         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'before blcloud')
    2865         ENDDO
    2866       IF (lcheckmass) THEN
    2867         DO itr=1,nbtr
    2868          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,   &
    2869            pplay,t_seri,iscm3,'before blcloud')
    2870         ENDDO
    2871       ENDIF
    2872         CALL minmaxsource(source_tr,qmin,qmax,'src: before blcloud')
    2873       ENDIF
    2874 
    2875 !      CALL blcloud_scav(lminmax,qmin,qmax,pdtphys,prfl,psfl,
    2876 !     .                  pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse,
    2877 !     .                                  his_dhbclsc,his_dhbccon,tr_seri)
    2878 
    2879         IF (iflag_conv==2) THEN
    2880 ! Tiedke
    2881 
    2882       CALL blcloud_scav(.false.,qmin,qmax,pdtphys,prfl,psfl,     &
    2883                        pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse,  &
    2884                                        his_dhbclsc,his_dhbccon,tr_seri)
    2885 
    2886 !---------- to use this option please comment lsc_scav at the end
    2887 !           and comment IF iflag=2 after "EFFECT OF PRECIPITATION:"
    2888 !       
    2889 !
    2890 !        ELSE IF (iflag_conv.GE.3) THEN
    2891 !
    2892 !      CALL blcloud_scav_lsc(.false.,qmin,qmax,pdtphys,prfl,psfl,
    2893 !     .                  pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse,
    2894 !     .                                  his_dhbclsc,his_dhbccon,tr_seri)
    2895 !
    2896 !----------------------------------------------------------------------
    2897         ENDIF
    2898 
    2899 
    2900       print *,' AFTER blcloud '
    2901 
    2902       IF (lminmax) THEN
    2903         DO itr=1,nbtr
    2904         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_after_blcloud')
    2905         ENDDO                           
    2906         DO itr=1,nbtr
    2907         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'after blcloud')
    2908         ENDDO                                 
    2909       IF (lcheckmass) THEN
    2910         DO itr=1,nbtr
    2911          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,  &
    2912            pplay,t_seri,iscm3,'after blcloud')
    2913         ENDDO
    2914       ENDIF
    2915         CALL minmaxsource(source_tr,qmin,qmax,'src: after blcloud')
    2916       ENDIF
    2917 
    2918 
    2919       ENDIF !--lessivage
    2920 
    2921       DO itr=1,nbtr
    2922          DO j=1,klev
    2923          DO i=1,klon
    2924            tmp_var(i,j)=tr_seri(i,j,itr)
    2925          ENDDO
    2926          ENDDO
    2927          CALL cm3_to_kg(pplay,t_seri,tmp_var)
    2928          DO j=1,klev
    2929          DO i=1,klon
    2930            tr_seri(i,j,itr)=tmp_var(i,j)
    2931          ENDDO
    2932          ENDDO
    2933       ENDDO
    2934        iscm3=.false.
    2935 !
    2936       IF (logitime) THEN
    2937       CALL SYSTEM_CLOCK(COUNT=clock_end)
    2938       dife=clock_end-clock_start
    2939       ti_wetap=dife*MAX(0,SIGN(1,dife))    &
    2940       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    2941       tia_wetap=tia_wetap+REAL(ti_wetap)/REAL(clock_rate)
    2942       ENDIF
    2943 
    2944 
    2945 
    2946 
    2947       ENDIF ! iflag_conv=2
    2948 
    2949 !
    2950 !
    2951 !======================================================================
    2952 !                         EFFECT OF CONVECTION
    2953 !======================================================================
    2954 !
     2847
     2848    ENDIF ! iflag_conv=2
     2849
     2850
     2851    !======================================================================
     2852    !                         EFFECT OF CONVECTION
     2853    !======================================================================
     2854
    29552855#ifdef IOPHYS_DUST
    29562856      do itr=1,nbtr
    … …  
    29612861
    29622862
    2963       IF (logitime) THEN
    2964       CALL SYSTEM_CLOCK(COUNT=clock_start)
     2863    IF (logitime) THEN
     2864      CALL SYSTEM_CLOCK(COUNT = clock_start)
     2865    ENDIF
     2866
     2867    IF (convection) THEN
     2868
     2869      print *, ' BEFORE trconvect'
     2870
     2871      IF (lminmax) THEN
     2872        DO itr = 1, nbtr
     2873          CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_trconve')
     2874        ENDDO
     2875        DO itr = 1, nbtr
     2876          CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before trconve')
     2877        ENDDO
     2878        IF (lcheckmass) THEN
     2879          DO itr = 1, nbtr
     2880            CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     2881                    pplay, t_seri, iscm3, 'before trconve')
     2882          ENDDO
     2883        ENDIF
     2884        CALL minmaxsource(source_tr, qmin, qmax, 'src: before trconve')
    29652885      ENDIF
    29662886
    29672887
    2968       IF (convection) THEN
    2969 !
    2970       print *,' BEFORE trconvect'
    2971 
     2888      ! JE        CALL trconvect(pplay,t_seri,pdtphys,pmfu,pmfd,pen_u,pde_u,
     2889      !     .             pen_d,pde_d,paprs,zdz,xconv,qmin,qmax,lminmax,masse,
     2890      !     .                                                 dtrconv,tr_seri)
     2891      ! -------------------------------------------------------------
     2892      IF (iflag_conv==2) THEN
     2893        ! Tiedke
     2894        CALL trconvect(pplay, t_seri, pdtphys, pmfu, pmfd, pen_u, pde_u, &
     2895                pen_d, pde_d, paprs, zdz, xconv, qmin, qmax, .false., masse, &
     2896                dtrconv, tr_seri)
     2897        DO itr = 1, nbtr
     2898          d_tr_cv(:, :, itr) = 0.
     2899        ENDDO
     2900
     2901      ELSE IF (iflag_conv>=3) THEN
     2902        ! KE
     2903        print *, 'JE: KE in phytracr_spl'
     2904        DO itr = 1, nbtr
     2905          DO k = 1, klev
     2906            DO i = 1, klon
     2907              tmp_var3(i, k, itr) = tr_seri(i, k, itr)
     2908            END DO
     2909          END DO
     2910        ENDDO
     2911
     2912        DO itr = 1, nbtr
     2913          !          routine for aerosols . otherwise, check cvltrorig
     2914          print *, 'Check sum before cvltr itr)', itr, SUM(tr_seri(:, :, itr))
     2915          !           IF (.FALSE.) THEN
     2916          CALL cvltr_spl(pdtphys, da, phi, phi2, d1a, dam, mp, ep, &
     2917                  sigd, sij, wght_cvfd, clw, elij, epmlmMm, eplaMm, &
     2918                  pmflxr, pmflxs, evapls, t_seri, wdtrainA, wdtrainM, &
     2919                  !            paprs,itr,tr_seri,upwd,dnwd,itop_con,ibas_con,        &
     2920                  paprs, itr, tmp_var3, upwd, dnwd, itop_con, ibas_con, &
     2921                  henry, kk, zrho, ccntrAA_spla, ccntrENV_spla, coefcoli_spla, &
     2922                  id_prec, id_fine, id_coss, id_codu, id_scdu, &
     2923                  d_tr_cv, d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav, qDi, qPr, &
     2924                  qPa, qMel, qTrdi, dtrcvMA, Mint, &
     2925                  zmfd1a, zmfphi2, zmfdam)
     2926          !           ENDIF
     2927
     2928          !           IF (.FALSE.) THEN
     2929          !           CALL cvltr(pdtphys, da, phi,phi2,d1a,dam, mp,ep,
     2930          !     .       sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,
     2931          !     .       pmflxr,pmflxs,evapls,t_seri,wdtrainA,wdtrainM,
     2932          !     .       paprs,itr,tmp_var3,upwd,dnwd,itop_con,ibas_con,
     2933          !     .       d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr,
     2934          !     .       qPa,qMel,qTrdi,dtrcvMA,Mint,
     2935          !     .       zmfd1a,zmfphi2,zmfdam)
     2936          !!  pas lessivage convectif pou n'est pas un aerosol (i/else with cvltr)
     2937          !           ENDIF
     2938
     2939
     2940
     2941          !!!!!!!         CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tr_seri,
     2942          !!!         CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tmp_var3,
     2943          !!!     .               upwd,dnwd,d_tr_cv)
     2944          !             print *,'justbefore cvltrnoscav it= ',it
     2945          !             CALL checknanqfi(da(:,:),1.,-1.,' da')
     2946          !             CALL checknanqfi(wght_cvfd(:,:),1.,-1.,'weigth ')
     2947          !             CALL checknanqfi(mp(:,:),1.,-1.,'mp ')
     2948          !             CALL checknanqfi(paprs(:,:),1.,-1.,'paprs ')
     2949          !             CALL checknanqfi(pplay(:,:),1.,-1.,'pplay ')
     2950          !             CALL checknanqfi(tmp_var3(:,:,itr),1.,-1.,'tmp_var3 ')
     2951          !             CALL checknanqfi(upwd(:,:),1.,-1.,'upwd ')
     2952          !             CALL checknanqfi(dnwd(:,:),1.,-1.,'dnwd ')
     2953          !             CALL checknanqfi(d_tr_cv(:,:,itr),1.,-1.,'d_tr_cv ')
     2954          !             IF (.TRUE.) THEN
     2955          !             CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs,
     2956          !     .            pplay,tmp_var3,upwd,dnwd,d_tr_cv)
     2957          !             ENDIF
     2958          DO k = 1, klev
     2959            DO i = 1, klon
     2960              !               tr_seri(i,k,itr) = tr_seri(i,k,itr) + d_tr_cv(i,k,itr)
     2961              tr_seri(i, k, itr) = (tmp_var3(i, k, itr) + d_tr_cv(i, k, itr))
     2962              tmp_var(i, k) = d_tr_cv(i, k, itr)
     2963
     2964            END DO
     2965          END DO
     2966
     2967          CALL kg_to_cm3(pplay, t_seri, tmp_var) !just for his_* computation
     2968
     2969          DO k = 1, klev
     2970            DO i = 1, klon
     2971              dtrconv(i, itr) = 0.0
     2972              his_dhkecv(i, itr) = his_dhkecv(i, itr) - tmp_var(i, k)  &
     2973                      / RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     2974            END DO
     2975          END DO
     2976
     2977          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2978          CALL kg_to_cm3(pplay, t_seri, tmp_var) !just for his_* computation
     2979
     2980          DO k = 1, klev
     2981            DO i = 1, klon
     2982              dtrconv(i, itr) = 0.0
     2983              his_ds(i, itr) = his_ds(i, itr) - tmp_var(i, k)  &
     2984                      / RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     2985            END DO
     2986          END DO
     2987          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2988          IF (lminmax) THEN
     2989
     2990            print *, 'Check sum after cvltr itr)', itr, SUM(tr_seri(:, :, itr))
     2991            CALL minmaxqfi2(d_tr_cv(:, :, itr), qmin, qmax, 'd_tr_cv:')
     2992            CALL minmaxqfi2(d_tr_trsp(:, :, itr), qmin, qmax, 'd_tr_trsp:')
     2993            CALL minmaxqfi2(d_tr_sscav(:, :, itr), qmin, qmax, 'd_tr_sscav:')
     2994            CALL minmaxqfi2(d_tr_sat(:, :, itr), qmin, qmax, 'd_tr_sat:')
     2995            CALL minmaxqfi2(d_tr_uscav(:, :, itr), qmin, qmax, 'd_tr_uscav:')
     2996            IF (lcheckmass) THEN
     2997              CALL checkmass(d_tr_cv(:, :, itr), RNAVO, masse(itr), zdz, &
     2998                      pplay, t_seri, .false., 'd_tr_cv:')
     2999            ENDIF
     3000          ENDIF
     3001        ENDDO ! it=1,nbtr
     3002
     3003      ENDIF ! iflag_conv
    29723004      IF (lminmax) THEN
    2973         DO itr=1,nbtr
    2974         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_before_trconve')
    2975         ENDDO
    2976         DO itr=1,nbtr
    2977         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'before trconve')
    2978         ENDDO
    2979       IF (lcheckmass) THEN
    2980         DO itr=1,nbtr
    2981          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,  &
    2982            pplay,t_seri,iscm3,'before trconve')
    2983         ENDDO
     3005        DO itr = 1, nbtr
     3006          CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_trcon')
     3007        ENDDO
     3008        DO itr = 1, nbtr
     3009          CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after trconv')
     3010        ENDDO
     3011        IF (lcheckmass) THEN
     3012          DO itr = 1, nbtr
     3013            CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     3014                    pplay, t_seri, iscm3, 'after trconv')
     3015          ENDDO
     3016        ENDIF
     3017        CALL minmaxsource(source_tr, qmin, qmax, 'src: after trconv')
    29843018      ENDIF
    2985         CALL minmaxsource(source_tr,qmin,qmax,'src: before trconve')
    2986       ENDIF
    2987 
    2988 
    2989 ! JE        CALL trconvect(pplay,t_seri,pdtphys,pmfu,pmfd,pen_u,pde_u,
    2990 !     .             pen_d,pde_d,paprs,zdz,xconv,qmin,qmax,lminmax,masse,
    2991 !     .                                                 dtrconv,tr_seri)
    2992 ! -------------------------------------------------------------     
    2993         IF (iflag_conv==2) THEN
    2994 ! Tiedke
    2995          CALL trconvect(pplay,t_seri,pdtphys,pmfu,pmfd,pen_u,pde_u,  &
    2996                   pen_d,pde_d,paprs,zdz,xconv,qmin,qmax,.false.,masse, &
    2997                                                       dtrconv,tr_seri)
    2998          DO itr=1,nbtr
    2999            d_tr_cv(:,:,itr)=0.
    3000          ENDDO
    3001 
    3002         ELSE IF (iflag_conv>=3) THEN
    3003 ! KE
    3004          print *,'JE: KE in phytracr_spl'
    3005          DO itr=1,nbtr
    3006              DO k = 1, klev
    3007               DO i = 1, klon
    3008                tmp_var3(i,k,itr)=tr_seri(i,k,itr)
    3009               END DO
    3010              END DO
    3011          ENDDO
    3012 
    3013          DO itr=1,nbtr
    3014 !          routine for aerosols . otherwise, check cvltrorig
    3015          print *,'Check sum before cvltr itr)',itr,SUM(tr_seri(:,:,itr))
    3016 !           IF (.FALSE.) THEN
    3017            CALL cvltr_spl(pdtphys, da, phi,phi2,d1a,dam, mp,ep,    &
    3018             sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,           &
    3019             pmflxr,pmflxs,evapls,t_seri,wdtrainA,wdtrainM,          &
    3020 !            paprs,itr,tr_seri,upwd,dnwd,itop_con,ibas_con,        &
    3021             paprs,itr,tmp_var3,upwd,dnwd,itop_con,ibas_con,        &
    3022             henry,kk,zrho,ccntrAA_spla,ccntrENV_spla,coefcoli_spla, &
    3023             id_prec,id_fine,id_coss, id_codu, id_scdu,              &
    3024             d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr, &
    3025             qPa,qMel,qTrdi,dtrcvMA,Mint,                            &
    3026             zmfd1a,zmfphi2,zmfdam)
    3027 !           ENDIF
    3028 !
    3029 !           IF (.FALSE.) THEN
    3030 !           CALL cvltr(pdtphys, da, phi,phi2,d1a,dam, mp,ep,
    3031 !     .       sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,
    3032 !     .       pmflxr,pmflxs,evapls,t_seri,wdtrainA,wdtrainM,
    3033 !     .       paprs,itr,tmp_var3,upwd,dnwd,itop_con,ibas_con,
    3034 !     .       d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr,
    3035 !     .       qPa,qMel,qTrdi,dtrcvMA,Mint,
    3036 !     .       zmfd1a,zmfphi2,zmfdam)
    3037 !!  pas lessivage convectif pou n'est pas un aerosol (i/else with cvltr)
    3038 !           ENDIF
    3039 
    3040 
    3041 
    3042 !!!!!!!         CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tr_seri,
    3043 !!!         CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tmp_var3,
    3044 !!!     .               upwd,dnwd,d_tr_cv)
    3045 !             print *,'justbefore cvltrnoscav it= ',it
    3046 !             CALL checknanqfi(da(:,:),1.,-1.,' da')
    3047 !             CALL checknanqfi(wght_cvfd(:,:),1.,-1.,'weigth ')
    3048 !             CALL checknanqfi(mp(:,:),1.,-1.,'mp ')
    3049 !             CALL checknanqfi(paprs(:,:),1.,-1.,'paprs ')
    3050 !             CALL checknanqfi(pplay(:,:),1.,-1.,'pplay ')
    3051 !             CALL checknanqfi(tmp_var3(:,:,itr),1.,-1.,'tmp_var3 ')
    3052 !             CALL checknanqfi(upwd(:,:),1.,-1.,'upwd ')
    3053 !             CALL checknanqfi(dnwd(:,:),1.,-1.,'dnwd ')
    3054 !             CALL checknanqfi(d_tr_cv(:,:,itr),1.,-1.,'d_tr_cv ')
    3055 !             IF (.TRUE.) THEN
    3056 !             CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs,
    3057 !     .            pplay,tmp_var3,upwd,dnwd,d_tr_cv)
    3058 !             ENDIF
    3059              DO k = 1, klev
    3060               DO i = 1, klon
    3061 !               tr_seri(i,k,itr) = tr_seri(i,k,itr) + d_tr_cv(i,k,itr)
    3062                tr_seri(i,k,itr)=(tmp_var3(i,k,itr)+d_tr_cv(i,k,itr))
    3063                tmp_var(i,k)=d_tr_cv(i,k,itr)
    3064 
    3065               END DO
    3066              END DO
    3067 
    3068         CALL kg_to_cm3(pplay,t_seri,tmp_var) !just for his_* computation
    3069 
    3070              DO k = 1, klev
    3071               DO i = 1, klon
    3072                dtrconv(i,itr)=0.0
    3073                his_dhkecv(i,itr)=his_dhkecv(i,itr)-tmp_var(i,k)  &
    3074                      /RNAVO*masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys
    3075               END DO
    3076              END DO
    3077 
    3078 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    3079         CALL kg_to_cm3(pplay,t_seri,tmp_var) !just for his_* computation
    3080 
    3081              DO k = 1, klev
    3082               DO i = 1, klon
    3083                dtrconv(i,itr)=0.0
    3084                his_ds(i,itr)=his_ds(i,itr)-tmp_var(i,k)  &
    3085                      /RNAVO*masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys
    3086               END DO
    3087              END DO
    3088 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    3089        IF (lminmax) THEN
    3090 
    3091          print *,'Check sum after cvltr itr)',itr,SUM(tr_seri(:,:,itr))
    3092         CALL minmaxqfi2(d_tr_cv(:,:,itr),qmin,qmax,'d_tr_cv:')
    3093         CALL minmaxqfi2(d_tr_trsp(:,:,itr),qmin,qmax,'d_tr_trsp:')
    3094         CALL minmaxqfi2(d_tr_sscav(:,:,itr),qmin,qmax,'d_tr_sscav:')
    3095         CALL minmaxqfi2(d_tr_sat(:,:,itr),qmin,qmax,'d_tr_sat:')
    3096         CALL minmaxqfi2(d_tr_uscav(:,:,itr),qmin,qmax,'d_tr_uscav:')
    3097       IF (lcheckmass) THEN
    3098         CALL checkmass(d_tr_cv(:,:,itr),RNAVO,masse(itr),zdz,  &
    3099            pplay,t_seri,.false.,'d_tr_cv:')
    3100       ENDIF
    3101        ENDIF
    3102          ENDDO ! it=1,nbtr
    3103 
    3104         ENDIF ! iflag_conv
    3105        IF (lminmax) THEN
    3106         DO itr=1,nbtr
    3107         CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_after_trcon')
    3108         ENDDO
    3109         DO itr=1,nbtr
    3110         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'after trconv')
    3111         ENDDO
    3112       IF (lcheckmass) THEN
    3113         DO itr=1,nbtr
    3114          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz, &
    3115            pplay,t_seri,iscm3,'after trconv')
    3116         ENDDO
    3117       ENDIF
    3118         CALL minmaxsource(source_tr,qmin,qmax,'src: after trconv')
    3119       ENDIF
    3120       ENDIF ! convection
    3121 
    3122       IF (logitime) THEN
    3123       CALL SYSTEM_CLOCK(COUNT=clock_end)
    3124       dife=clock_end-clock_start
    3125       ti_cvltr=dife*MAX(0,SIGN(1,dife))   &
    3126       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    3127       tia_cvltr=tia_cvltr+REAL(ti_cvltr)/REAL(clock_rate)
    3128       ENDIF
    3129 
    3130 
    3131 
    3132 !
    3133 !
    3134 !=======================================================================
    3135 !      LARGE SCALE SCAVENGING KE
    3136 !=======================================================================
    3137 !     
     3019    ENDIF ! convection
     3020
     3021    IF (logitime) THEN
     3022      CALL SYSTEM_CLOCK(COUNT = clock_end)
     3023      dife = clock_end - clock_start
     3024      ti_cvltr = dife * MAX(0, SIGN(1, dife))   &
     3025              + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     3026      tia_cvltr = tia_cvltr + REAL(ti_cvltr) / REAL(clock_rate)
     3027    ENDIF
     3028
     3029
     3030    !=======================================================================
     3031    !      LARGE SCALE SCAVENGING KE
     3032    !=======================================================================
     3033
    31383034#ifdef IOPHYS_DUST
    31393035      call iophys_ecrit('da',klev,'da','',da)
    … …  
    31643060
    31653061
    3166        IF (iflag_conv>=3) THEN
    3167        IF (logitime) THEN
    3168        CALL SYSTEM_CLOCK(COUNT=clock_start)
    3169        ENDIF
    3170 
    3171 
    3172        IF (lessivage)  THEN
    3173        print *,' BEFORE lsc_scav '
    3174        IF (lminmax) THEN
    3175         DO itr=1,nbtr
    3176        CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_before_lsc_scav')
    3177         ENDDO
    3178         DO itr=1,nbtr
    3179         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'before lsc_scav')
    3180         ENDDO
    3181       IF (lcheckmass) THEN
    3182         DO itr=1,nbtr
    3183          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,  &
    3184            pplay,t_seri,iscm3,'before lsc_scav')
    3185         ENDDO
     3062    IF (iflag_conv>=3) THEN
     3063      IF (logitime) THEN
     3064        CALL SYSTEM_CLOCK(COUNT = clock_start)
    31863065      ENDIF
    3187         CALL minmaxsource(source_tr,qmin,qmax,'src: before lsc_scav')
     3066
     3067      IF (lessivage)  THEN
     3068        print *, ' BEFORE lsc_scav '
     3069        IF (lminmax) THEN
     3070          DO itr = 1, nbtr
     3071            CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_lsc_scav')
     3072          ENDDO
     3073          DO itr = 1, nbtr
     3074            CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before lsc_scav')
     3075          ENDDO
     3076          IF (lcheckmass) THEN
     3077            DO itr = 1, nbtr
     3078              CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     3079                      pplay, t_seri, iscm3, 'before lsc_scav')
     3080            ENDDO
     3081          ENDIF
     3082          CALL minmaxsource(source_tr, qmin, qmax, 'src: before lsc_scav')
     3083        ENDIF
     3084
     3085        ql_incloud_ref = 10.e-4
     3086        ql_incloud_ref = 5.e-4
     3087        ! calcul du contenu en eau liquide au sein du nuage
     3088        ql_incl = ql_incloud_ref
     3089        ! choix du lessivage
     3090        IF (iflag_lscav == 3 .OR. iflag_lscav == 4) THEN
     3091          !IF (.false.) THEN  ! test #DFB (Binta) sans lsc_scav_spl
     3092          print *, 'JE iflag_lscav', iflag_lscav
     3093          DO itr = 1, nbtr
     3094
     3095            !       incloud scavenging and removal by large scale rain ! orig : ql_incl
     3096            !         was replaced by 0.5e-3 kg/kg
     3097            !          the value 0.5e-3 kg/kg is from Giorgi and Chameides (1986), JGR
     3098            !         Liu (2001) proposed to use 1.5e-3 kg/kg
     3099
     3100            !       CALL lsc_scav_orig(pdtphys,itr,iflag_lscav,ql_incl,prfl,psfl,
     3101            !     .               rneb,beta_fisrt, beta_v1,pplay,paprs,
     3102            !     .               t_seri,tr_seri,d_tr_insc,
     3103            !     .               d_tr_bcscav,d_tr_evapls,qPrls)
     3104            CALL lsc_scav_spl(pdtphys, itr, iflag_lscav, ql_incl, prfl, psfl, &
     3105                    rneb, beta_fisrt, beta_v1, pplay, paprs, &
     3106                    t_seri, tr_seri, d_tr_insc, &
     3107                    alpha_r, alpha_s, kk, henry, &
     3108                    id_prec, id_fine, id_coss, id_codu, id_scdu, &
     3109                    d_tr_bcscav, d_tr_evapls, qPrls)
     3110
     3111            !large scale scavenging tendency
     3112            DO k = 1, klev
     3113              DO i = 1, klon
     3114                d_tr_ls(i, k, itr) = d_tr_insc(i, k, itr) + d_tr_bcscav(i, k, itr) &
     3115                        + d_tr_evapls(i, k, itr)
     3116                tr_seri(i, k, itr) = tr_seri(i, k, itr) + d_tr_ls(i, k, itr)
     3117                tmp_var(i, k) = d_tr_ls(i, k, itr)
     3118              ENDDO
     3119            ENDDO
     3120
     3121            CALL kg_to_cm3(pplay, t_seri, tmp_var)
     3122
     3123            DO k = 1, klev
     3124              DO i = 1, klon
     3125                his_dhkelsc(i, itr) = his_dhkelsc(i, itr) - tmp_var(i, k)    &
     3126                        / RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     3127
     3128              END DO
     3129            END DO
     3130
     3131          END DO  !it=1,nbtr
     3132
     3133        ELSE
     3134          print *, 'WARNING: NO lsc_scav, Please choose iflag_lscav=3 or 4'
     3135          DO itr = 1, nbtr
     3136            DO i = 1, klon
     3137              his_dhkelsc(i, itr) = 0.0
     3138            END DO  ! klon
     3139          END DO  !it=1,nbtr
     3140        ENDIF !iflag_lscav
     3141
     3142        print *, ' AFTER lsc_scav '
     3143        IF (lminmax) THEN
     3144          DO itr = 1, nbtr
     3145            CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_lsc_scav')
     3146          ENDDO
     3147          DO itr = 1, nbtr
     3148            CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after lsc_scav')
     3149          ENDDO
     3150          IF (lcheckmass) THEN
     3151            DO itr = 1, nbtr
     3152              CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
     3153                      pplay, t_seri, iscm3, 'after lsc_scav')
     3154            ENDDO
     3155          ENDIF
     3156          CALL minmaxsource(source_tr, qmin, qmax, 'src: after lsc_scav')
     3157        ENDIF
     3158
     3159      ENDIF ! lessivage
     3160
     3161      IF (logitime) THEN
     3162        CALL SYSTEM_CLOCK(COUNT = clock_end)
     3163        dife = clock_end - clock_start
     3164        ti_lscs = dife * MAX(0, SIGN(1, dife))   &
     3165                + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     3166        tia_lscs = tia_lscs + REAL(ti_lscs) / REAL(clock_rate)
    31883167      ENDIF
    31893168
    3190 
    3191 
    3192        ql_incloud_ref = 10.e-4
    3193        ql_incloud_ref =  5.e-4
    3194 ! calcul du contenu en eau liquide au sein du nuage
    3195        ql_incl = ql_incloud_ref
    3196 ! choix du lessivage
    3197       IF (iflag_lscav == 3 .OR. iflag_lscav == 4) THEN
    3198       !IF (.false.) THEN  ! test #DFB (Binta) sans lsc_scav_spl
    3199         print *,'JE iflag_lscav',iflag_lscav
    3200         DO itr=1,nbtr
    3201 
    3202 !       incloud scavenging and removal by large scale rain ! orig : ql_incl
    3203 !         was replaced by 0.5e-3 kg/kg
    3204 !          the value 0.5e-3 kg/kg is from Giorgi and Chameides (1986), JGR
    3205 !         Liu (2001) proposed to use 1.5e-3 kg/kg
    3206 
    3207 !       CALL lsc_scav_orig(pdtphys,itr,iflag_lscav,ql_incl,prfl,psfl,
    3208 !     .               rneb,beta_fisrt, beta_v1,pplay,paprs,
    3209 !     .               t_seri,tr_seri,d_tr_insc,
    3210 !     .               d_tr_bcscav,d_tr_evapls,qPrls)
    3211           CALL lsc_scav_spl(pdtphys,itr,iflag_lscav,ql_incl,prfl,psfl,  &
    3212                     rneb,beta_fisrt, beta_v1,pplay,paprs,      &
    3213                     t_seri,tr_seri,d_tr_insc,                  &
    3214                     alpha_r,alpha_s,kk, henry,                 &
    3215                     id_prec,id_fine,id_coss, id_codu, id_scdu, &
    3216                     d_tr_bcscav,d_tr_evapls,qPrls)
    3217 
    3218 !large scale scavenging tendency
    3219           DO k = 1, klev
    3220            DO i = 1, klon
    3221                 d_tr_ls(i,k,itr)=d_tr_insc(i,k,itr)+d_tr_bcscav(i,k,itr) &
    3222                         +d_tr_evapls(i,k,itr)
    3223                 tr_seri(i,k,itr)=tr_seri(i,k,itr)+d_tr_ls(i,k,itr)
    3224                          tmp_var(i,k)=d_tr_ls(i,k,itr)
    3225            ENDDO
    3226           ENDDO
    3227 
    3228           CALL kg_to_cm3(pplay,t_seri,tmp_var)
    3229 
    3230           DO k=1,klev
    3231            DO i=1,klon
    3232             his_dhkelsc(i,itr)=his_dhkelsc(i,itr)-tmp_var(i,k)    &
    3233                      /RNAVO*masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys
    3234      
    3235            END DO
    3236           END DO
    3237 
    3238         END DO  !it=1,nbtr
    3239 
    3240       ELSE
    3241         print *,'WARNING: NO lsc_scav, Please choose iflag_lscav=3 or 4'
    3242         DO itr=1,nbtr
    3243           DO i=1,klon
    3244             his_dhkelsc(i,itr)=0.0
    3245           END DO  ! klon
    3246          END DO  !it=1,nbtr
    3247       ENDIF !iflag_lscav
    3248 
    3249        print *,' AFTER lsc_scav '
    3250        IF (lminmax) THEN
    3251         DO itr=1,nbtr
    3252        CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan_after_lsc_scav')
    3253         ENDDO
    3254         DO itr=1,nbtr
    3255         CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'after lsc_scav')
    3256         ENDDO
    3257       IF (lcheckmass) THEN
    3258         DO itr=1,nbtr
    3259          CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz, &
    3260            pplay,t_seri,iscm3,'after lsc_scav')
    3261         ENDDO
    3262        ENDIF
    3263         CALL minmaxsource(source_tr,qmin,qmax,'src: after lsc_scav')
    3264       ENDIF
    3265 
    3266       ENDIF ! lessivage
    3267  
    3268       IF (logitime) THEN
    3269       CALL SYSTEM_CLOCK(COUNT=clock_end)
    3270       dife=clock_end-clock_start
    3271       ti_lscs=dife*MAX(0,SIGN(1,dife))   &
    3272       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    3273       tia_lscs=tia_lscs+REAL(ti_lscs)/REAL(clock_rate)
    3274       ENDIF
    3275 
    3276 
    3277 
    3278       ENDIF !iflag_conv
    3279 
    3280  
    3281 !=======================================================================
    3282 !                         COMPUTING THE BURDEN
    3283 !=======================================================================
     3169    ENDIF !iflag_conv
     3170
     3171
     3172    !=======================================================================
     3173    !                         COMPUTING THE BURDEN
     3174    !=======================================================================
    32843175#ifdef IOPHYS_DUST
    32853176      do itr=1,nbtr
    … …  
    32893180#endif
    32903181
    3291 !   
    3292       IF (logitime) THEN
    3293       CALL SYSTEM_CLOCK(COUNT=clock_start)
    3294       ENDIF
    3295 
    3296  
    3297       DO itr=1,nbtr
    3298         DO j=1,klev
    3299         DO i=1,klon
    3300            tmp_var(i,j)=tr_seri(i,j,itr)
    3301         ENDDO
    3302         ENDDO
    3303         CALL kg_to_cm3(pplay,t_seri,tmp_var)
    3304         DO j=1,klev
    3305         DO i=1,klon
    3306            tr_seri(i,j,itr)=tmp_var(i,j)
    3307         ENDDO
    3308         ENDDO
    3309       ENDDO
    3310        iscm3=.true.
    3311 
    3312 !
    3313 ! Computing burden in mg/m2
    3314       DO itr=1,nbtr
    3315       DO k=1, klev
    3316       DO i=1, klon
    3317         trm(i,itr)=trm(i,itr)+tr_seri(i,k,itr)*1.e6*zdz(i,k)*  &
    3318                  masse(itr)*1.e3/RNAVO     !--mg S/m2
    3319       ENDDO
    3320       ENDDO
    3321       ENDDO
    3322 !
    3323 ! Computing Surface concentration in ug/m3
    3324 !
    3325       DO itr=1,nbtr
    3326       DO i=1, klon
    3327         sconc_seri(i,itr)=tr_seri(i,1,itr)*1.e6* &
    3328                  masse(itr)*1.e3/RNAVO     !--mg/m3 (tr_seri ist in g/cm3)
    3329       ENDDO
    3330       ENDDO
    3331 !
    3332 !=======================================================================
    3333 !                  CALCULATION OF OPTICAL PROPERTIES
    3334 !=======================================================================
    3335 !     
    3336       CALL aeropt_spl(zdz, tr_seri, RHcl,                                 &
    3337                         id_prec, id_fine, id_coss, id_codu, id_scdu,     &
    3338                         ok_chimeredust,                                 &
    3339                     diff_aod550_tot, diag_aod670_tot, diag_aod865_tot,     &
    3340                     diff_aod550_tr2, diag_aod670_tr2, diag_aod865_tr2,     &
    3341                     diag_aod550_ss,  diag_aod670_ss,  diag_aod865_ss,        &
    3342                     diag_aod550_dust,diag_aod670_dust,diag_aod865_dust,  &
    3343            diag_aod550_dustsco,diag_aod670_dustsco,diag_aod865_dustsco) 
    3344 
    3345 
    3346 
    3347       IF (logitime) THEN
    3348       CALL SYSTEM_CLOCK(COUNT=clock_end)
    3349       dife=clock_end-clock_start
    3350       ti_brop=dife*MAX(0,SIGN(1,dife))   &
    3351       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    3352       tia_brop=tia_brop+REAL(ti_brop)/REAL(clock_rate)
    3353       ENDIF
    3354 
    3355 
    3356 !=======================================================================
    3357 !   MODIS terra/aqua simulation output
    3358 !=======================================================================
    3359       masque_aqua_cur(:)=0
    3360       masque_terra_cur(:)=0
    3361 
    3362       CALL satellite_out_spla(jD_cur,jH_cur,pdtphys,rlat,rlon,   &
    3363                               masque_aqua_cur, masque_terra_cur )
    3364       IF (jH_cur-pdtphys/86400. < 0.) THEN
    3365        !new utc day: put in 0 everything
    3366 !JE20150518<<
    3367        masque_aqua(:) =0
    3368        masque_terra(:) =0
    3369        aod550_terra(:)=0. 
    3370        aod550_tr2_terra(:)=0. 
    3371        aod550_ss_terra(:)=0.   
    3372        aod550_dust_terra(:)=0.   
    3373        aod550_dustsco_terra(:)=0.   
    3374        aod670_terra(:)=0.   
    3375        aod670_tr2_terra(:)=0. 
    3376        aod670_ss_terra(:)=0. 
    3377        aod670_dust_terra(:)=0. 
    3378        aod670_dustsco_terra(:)=0. 
    3379        aod865_terra(:)=0.   
    3380        aod865_tr2_terra(:)=0. 
    3381        aod865_ss_terra(:)=0. 
    3382        aod865_dust_terra(:)=0. 
    3383        aod865_dustsco_terra(:)=0. 
    3384        aod550_aqua(:)=0. 
    3385        aod550_tr2_aqua(:)=0. 
    3386        aod550_ss_aqua(:)=0.   
    3387        aod550_dust_aqua(:)=0.   
    3388        aod550_dustsco_aqua(:)=0.   
    3389        aod670_aqua(:)=0.   
    3390        aod670_tr2_aqua(:)=0. 
    3391        aod670_ss_aqua(:)=0. 
    3392        aod670_dust_aqua(:)=0. 
    3393        aod670_dustsco_aqua(:)=0. 
    3394        aod865_aqua(:)=0.   
    3395        aod865_tr2_aqua(:)=0. 
    3396        aod865_ss_aqua(:)=0. 
    3397        aod865_dust_aqua(:)=0. 
    3398        aod865_dustsco_aqua(:)=0. 
    3399 !JE20150518>>
    3400       ENDIF
    3401 
    3402       DO i=1,klon
    3403 
    3404        aod550_terra(i)=aod550_terra(i)+   &
    3405                        masque_terra_cur(i)*diff_aod550_tot(i)
    3406        aod550_tr2_terra(i)= aod550_tr2_terra(i)+ &
    3407                        masque_terra_cur(i)*diff_aod550_tr2(i)
    3408        aod550_ss_terra(i)=aod550_ss_terra(i) + &
    3409                        masque_terra_cur(i)*diag_aod550_ss(i)
    3410        aod550_dust_terra(i)=  aod550_dust_terra(i) + &
    3411                        masque_terra_cur(i)*diag_aod550_dust(i)
    3412        aod550_dustsco_terra(i)= aod550_dustsco_terra(i) + &
    3413                        masque_terra_cur(i)*diag_aod550_dustsco(i)
    3414        aod670_terra(i)=aod670_terra(i)+   &
    3415                        masque_terra_cur(i)*diag_aod670_tot(i)
    3416        aod670_tr2_terra(i)= aod670_tr2_terra(i)+ &
    3417                        masque_terra_cur(i)*diag_aod670_tr2(i)
    3418        aod670_ss_terra(i)=aod670_ss_terra(i) + &
    3419                        masque_terra_cur(i)*diag_aod670_ss(i)
    3420        aod670_dust_terra(i)=  aod670_dust_terra(i) + &
    3421                        masque_terra_cur(i)*diag_aod670_dust(i)
    3422        aod670_dustsco_terra(i)= aod670_dustsco_terra(i) + &
    3423                        masque_terra_cur(i)*diag_aod670_dustsco(i)
    3424        aod865_terra(i)=aod865_terra(i)+   &
    3425                        masque_terra_cur(i)*diag_aod865_tot(i)
    3426        aod865_tr2_terra(i)= aod865_tr2_terra(i)+ &
    3427                        masque_terra_cur(i)*diag_aod865_tr2(i)
    3428        aod865_ss_terra(i)=aod865_ss_terra(i) + &
    3429                        masque_terra_cur(i)*diag_aod865_ss(i)
    3430        aod865_dust_terra(i)=  aod865_dust_terra(i) + &
    3431                        masque_terra_cur(i)*diag_aod865_dust(i)
    3432        aod865_dustsco_terra(i)= aod865_dustsco_terra(i) + &
    3433                        masque_terra_cur(i)*diag_aod865_dustsco(i)
    3434 
    3435 
    3436 
    3437        aod550_aqua(i)=aod550_aqua(i)+   &
    3438                        masque_aqua_cur(i)*diff_aod550_tot(i)
    3439        aod550_tr2_aqua(i)= aod550_tr2_aqua(i)+ &
    3440                        masque_aqua_cur(i)*diff_aod550_tr2(i)
    3441        aod550_ss_aqua(i)=aod550_ss_aqua(i) + &
    3442                        masque_aqua_cur(i)*diag_aod550_ss(i)
    3443        aod550_dust_aqua(i)=  aod550_dust_aqua(i) + &
    3444                        masque_aqua_cur(i)*diag_aod550_dust(i)
    3445        aod550_dustsco_aqua(i)= aod550_dustsco_aqua(i) + &
    3446                        masque_aqua_cur(i)*diag_aod550_dustsco(i)
    3447        aod670_aqua(i)=aod670_aqua(i)+   &
    3448                        masque_aqua_cur(i)*diag_aod670_tot(i)
    3449        aod670_tr2_aqua(i)= aod670_tr2_aqua(i)+ &
    3450                        masque_aqua_cur(i)*diag_aod670_tr2(i)
    3451        aod670_ss_aqua(i)=aod670_ss_aqua(i) + &
    3452                        masque_aqua_cur(i)*diag_aod670_ss(i)
    3453        aod670_dust_aqua(i)=  aod670_dust_aqua(i) + &
    3454                        masque_aqua_cur(i)*diag_aod670_dust(i)
    3455        aod670_dustsco_aqua(i)= aod670_dustsco_aqua(i) + &
    3456                        masque_aqua_cur(i)*diag_aod670_dustsco(i)
    3457        aod865_aqua(i)=aod865_aqua(i)+   &
    3458                        masque_aqua_cur(i)*diag_aod865_tot(i)
    3459        aod865_tr2_aqua(i)= aod865_tr2_aqua(i)+ &
    3460                        masque_aqua_cur(i)*diag_aod865_tr2(i)
    3461        aod865_ss_aqua(i)=aod865_ss_aqua(i) + &
    3462                        masque_aqua_cur(i)*diag_aod865_ss(i)
    3463        aod865_dust_aqua(i)=  aod865_dust_aqua(i) + &
    3464                        masque_aqua_cur(i)*diag_aod865_dust(i)
    3465        aod865_dustsco_aqua(i)= aod865_dustsco_aqua(i) + &
    3466                        masque_aqua_cur(i)*diag_aod865_dustsco(i)
    3467 
    3468                masque_aqua(i)=masque_aqua(i)+masque_aqua_cur(i)
    3469          masque_terra(i)=masque_terra(i)+masque_terra_cur(i)
    3470       ENDDO
    3471 
    3472       IF (jH_cur+pdtphys/86400. >= 1.) THEN
    3473 !          print *,'last step of the day'
    3474           DO i=1,klon
    3475                IF (masque_aqua(i)> 0) THEN
    3476                    aod550_aqua(i)=aod550_aqua(i)/masque_aqua(i)
    3477                    aod670_aqua(i)=aod670_aqua(i)/masque_aqua(i)
    3478                    aod865_aqua(i)=aod865_aqua(i)/masque_aqua(i)
    3479                    aod550_tr2_aqua(i)=aod550_tr2_aqua(i)/masque_aqua(i)
    3480                    aod670_tr2_aqua(i)=aod670_tr2_aqua(i)/masque_aqua(i)
    3481                    aod865_tr2_aqua(i)=aod865_tr2_aqua(i)/masque_aqua(i)
    3482                    aod550_ss_aqua(i)=aod550_ss_aqua(i)/masque_aqua(i)
    3483                    aod670_ss_aqua(i)=aod670_ss_aqua(i)/masque_aqua(i)
    3484                    aod865_ss_aqua(i)=aod865_ss_aqua(i)/masque_aqua(i)
    3485                    aod550_dust_aqua(i)=aod550_dust_aqua(i)/masque_aqua(i)
    3486                    aod670_dust_aqua(i)=aod670_dust_aqua(i)/masque_aqua(i)
    3487                    aod865_dust_aqua(i)=aod865_dust_aqua(i)/masque_aqua(i)
    3488                    aod550_dustsco_aqua(i)=aod550_dustsco_aqua(i)/masque_aqua(i)
    3489                    aod670_dustsco_aqua(i)=aod670_dustsco_aqua(i)/masque_aqua(i)
    3490                    aod865_dustsco_aqua(i)=aod865_dustsco_aqua(i)/masque_aqua(i)
    3491                ELSE
    3492                    aod550_aqua(i) = -999.
    3493                    aod670_aqua(i) = -999.
    3494                    aod865_aqua(i) = -999.
    3495                    aod550_tr2_aqua(i)= -999.
    3496                    aod670_tr2_aqua(i)= -999.
    3497                    aod865_tr2_aqua(i)= -999.
    3498                    aod550_ss_aqua(i)= -999.
    3499                    aod670_ss_aqua(i)= -999.
    3500                    aod865_ss_aqua(i)= -999.
    3501                    aod550_dust_aqua(i)= -999.
    3502                    aod670_dust_aqua(i)= -999.
    3503                    aod865_dust_aqua(i)= -999.
    3504                    aod550_dustsco_aqua(i)= -999.
    3505                    aod670_dustsco_aqua(i)= -999.
    3506                    aod865_dustsco_aqua(i)= -999.
    3507                ENDIF
    3508                IF (masque_terra(i)> 0) THEN
    3509                    aod550_terra(i)=aod550_terra(i)/masque_terra(i)
    3510                    aod670_terra(i)=aod670_terra(i)/masque_terra(i)
    3511                    aod865_terra(i)=aod865_terra(i)/masque_terra(i)
    3512                    aod550_tr2_terra(i)=aod550_tr2_terra(i)/masque_terra(i)
    3513                    aod670_tr2_terra(i)=aod670_tr2_terra(i)/masque_terra(i)
    3514                    aod865_tr2_terra(i)=aod865_tr2_terra(i)/masque_terra(i)
    3515                    aod550_ss_terra(i)=aod550_ss_terra(i)/masque_terra(i)
    3516                    aod670_ss_terra(i)=aod670_ss_terra(i)/masque_terra(i)
    3517                    aod865_ss_terra(i)=aod865_ss_terra(i)/masque_terra(i)
    3518                    aod550_dust_terra(i)=aod550_dust_terra(i)/masque_terra(i)
    3519                    aod670_dust_terra(i)=aod670_dust_terra(i)/masque_terra(i)
    3520                    aod865_dust_terra(i)=aod865_dust_terra(i)/masque_terra(i)
    3521                    aod550_dustsco_terra(i)=aod550_dustsco_terra(i)/masque_terra(i)
    3522                    aod670_dustsco_terra(i)=aod670_dustsco_terra(i)/masque_terra(i)
    3523                    aod865_dustsco_terra(i)=aod865_dustsco_terra(i)/masque_terra(i)
    3524                ELSE
    3525                    aod550_terra(i) = -999.
    3526                    aod670_terra(i) = -999.
    3527                    aod865_terra(i) = -999.
    3528                    aod550_tr2_terra(i)= -999.
    3529                    aod670_tr2_terra(i)= -999.
    3530                    aod865_tr2_terra(i)= -999.
    3531                    aod550_ss_terra(i)= -999.
    3532                    aod670_ss_terra(i)= -999.
    3533                    aod865_ss_terra(i)= -999.
    3534                    aod550_dust_terra(i)= -999.
    3535                    aod670_dust_terra(i)= -999.
    3536                    aod865_dust_terra(i)= -999.
    3537                    aod550_dustsco_terra(i)= -999.
    3538                    aod670_dustsco_terra(i)= -999.
    3539                    aod865_dustsco_terra(i)= -999.
    3540                ENDIF
    3541           ENDDO         
    3542 
    3543 !!AS deleting lines
    3544 !!      IF (ok_histrac) THEN
    3545 !!!!      write in output file
    3546 !!----many deleted lines
    3547 !!      ENDIF  !mpi_root
    3548 !!!$OMP END MASTER
    3549 !!!$OMP BARRIER
    3550 !!      ENDIF  !--ok_histrac
    3551 
    3552       ENDIF ! jH_cur...
    3553 
    3554 
    3555 !
    3556 !======================================================================
    3557 !  Stockage sur bande histoire
    3558 !======================================================================
     3182    IF (logitime) THEN
     3183      CALL SYSTEM_CLOCK(COUNT = clock_start)
     3184    ENDIF
     3185
     3186    DO itr = 1, nbtr
     3187      DO j = 1, klev
     3188        DO i = 1, klon
     3189          tmp_var(i, j) = tr_seri(i, j, itr)
     3190        ENDDO
     3191      ENDDO
     3192      CALL kg_to_cm3(pplay, t_seri, tmp_var)
     3193      DO j = 1, klev
     3194        DO i = 1, klon
     3195          tr_seri(i, j, itr) = tmp_var(i, j)
     3196        ENDDO
     3197      ENDDO
     3198    ENDDO
     3199    iscm3 = .true.
     3200
     3201    ! Computing burden in mg/m2
     3202    DO itr = 1, nbtr
     3203      DO k = 1, klev
     3204        DO i = 1, klon
     3205          trm(i, itr) = trm(i, itr) + tr_seri(i, k, itr) * 1.e6 * zdz(i, k) * &
     3206                  masse(itr) * 1.e3 / RNAVO     !--mg S/m2
     3207        ENDDO
     3208      ENDDO
     3209    ENDDO
     3210
     3211    ! Computing Surface concentration in ug/m3
     3212
     3213    DO itr = 1, nbtr
     3214      DO i = 1, klon
     3215        sconc_seri(i, itr) = tr_seri(i, 1, itr) * 1.e6 * &
     3216                masse(itr) * 1.e3 / RNAVO     !--mg/m3 (tr_seri ist in g/cm3)
     3217      ENDDO
     3218    ENDDO
     3219
     3220    !=======================================================================
     3221    !                  CALCULATION OF OPTICAL PROPERTIES
     3222    !=======================================================================
     3223
     3224    CALL aeropt_spl(zdz, tr_seri, RHcl, &
     3225            id_prec, id_fine, id_coss, id_codu, id_scdu, &
     3226            ok_chimeredust, &
     3227            diff_aod550_tot, diag_aod670_tot, diag_aod865_tot, &
     3228            diff_aod550_tr2, diag_aod670_tr2, diag_aod865_tr2, &
     3229            diag_aod550_ss, diag_aod670_ss, diag_aod865_ss, &
     3230            diag_aod550_dust, diag_aod670_dust, diag_aod865_dust, &
     3231            diag_aod550_dustsco, diag_aod670_dustsco, diag_aod865_dustsco)
     3232
     3233    IF (logitime) THEN
     3234      CALL SYSTEM_CLOCK(COUNT = clock_end)
     3235      dife = clock_end - clock_start
     3236      ti_brop = dife * MAX(0, SIGN(1, dife))   &
     3237              + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     3238      tia_brop = tia_brop + REAL(ti_brop) / REAL(clock_rate)
     3239    ENDIF
     3240
     3241
     3242    !=======================================================================
     3243    !   MODIS terra/aqua simulation output
     3244    !=======================================================================
     3245    masque_aqua_cur(:) = 0
     3246    masque_terra_cur(:) = 0
     3247
     3248    CALL satellite_out_spla(jD_cur, jH_cur, pdtphys, rlat, rlon, &
     3249            masque_aqua_cur, masque_terra_cur)
     3250    IF (jH_cur - pdtphys / 86400. < 0.) THEN
     3251      !new utc day: put in 0 everything
     3252      !JE20150518<<
     3253      masque_aqua(:) = 0
     3254      masque_terra(:) = 0
     3255      aod550_terra(:) = 0.
     3256      aod550_tr2_terra(:) = 0.
     3257      aod550_ss_terra(:) = 0.
     3258      aod550_dust_terra(:) = 0.
     3259      aod550_dustsco_terra(:) = 0.
     3260      aod670_terra(:) = 0.
     3261      aod670_tr2_terra(:) = 0.
     3262      aod670_ss_terra(:) = 0.
     3263      aod670_dust_terra(:) = 0.
     3264      aod670_dustsco_terra(:) = 0.
     3265      aod865_terra(:) = 0.
     3266      aod865_tr2_terra(:) = 0.
     3267      aod865_ss_terra(:) = 0.
     3268      aod865_dust_terra(:) = 0.
     3269      aod865_dustsco_terra(:) = 0.
     3270      aod550_aqua(:) = 0.
     3271      aod550_tr2_aqua(:) = 0.
     3272      aod550_ss_aqua(:) = 0.
     3273      aod550_dust_aqua(:) = 0.
     3274      aod550_dustsco_aqua(:) = 0.
     3275      aod670_aqua(:) = 0.
     3276      aod670_tr2_aqua(:) = 0.
     3277      aod670_ss_aqua(:) = 0.
     3278      aod670_dust_aqua(:) = 0.
     3279      aod670_dustsco_aqua(:) = 0.
     3280      aod865_aqua(:) = 0.
     3281      aod865_tr2_aqua(:) = 0.
     3282      aod865_ss_aqua(:) = 0.
     3283      aod865_dust_aqua(:) = 0.
     3284      aod865_dustsco_aqua(:) = 0.
     3285      !JE20150518>>
     3286    ENDIF
     3287
     3288    DO i = 1, klon
     3289
     3290      aod550_terra(i) = aod550_terra(i) + &
     3291              masque_terra_cur(i) * diff_aod550_tot(i)
     3292      aod550_tr2_terra(i) = aod550_tr2_terra(i) + &
     3293              masque_terra_cur(i) * diff_aod550_tr2(i)
     3294      aod550_ss_terra(i) = aod550_ss_terra(i) + &
     3295              masque_terra_cur(i) * diag_aod550_ss(i)
     3296      aod550_dust_terra(i) = aod550_dust_terra(i) + &
     3297              masque_terra_cur(i) * diag_aod550_dust(i)
     3298      aod550_dustsco_terra(i) = aod550_dustsco_terra(i) + &
     3299              masque_terra_cur(i) * diag_aod550_dustsco(i)
     3300      aod670_terra(i) = aod670_terra(i) + &
     3301              masque_terra_cur(i) * diag_aod670_tot(i)
     3302      aod670_tr2_terra(i) = aod670_tr2_terra(i) + &
     3303              masque_terra_cur(i) * diag_aod670_tr2(i)
     3304      aod670_ss_terra(i) = aod670_ss_terra(i) + &
     3305              masque_terra_cur(i) * diag_aod670_ss(i)
     3306      aod670_dust_terra(i) = aod670_dust_terra(i) + &
     3307              masque_terra_cur(i) * diag_aod670_dust(i)
     3308      aod670_dustsco_terra(i) = aod670_dustsco_terra(i) + &
     3309              masque_terra_cur(i) * diag_aod670_dustsco(i)
     3310      aod865_terra(i) = aod865_terra(i) + &
     3311              masque_terra_cur(i) * diag_aod865_tot(i)
     3312      aod865_tr2_terra(i) = aod865_tr2_terra(i) + &
     3313              masque_terra_cur(i) * diag_aod865_tr2(i)
     3314      aod865_ss_terra(i) = aod865_ss_terra(i) + &
     3315              masque_terra_cur(i) * diag_aod865_ss(i)
     3316      aod865_dust_terra(i) = aod865_dust_terra(i) + &
     3317              masque_terra_cur(i) * diag_aod865_dust(i)
     3318      aod865_dustsco_terra(i) = aod865_dustsco_terra(i) + &
     3319              masque_terra_cur(i) * diag_aod865_dustsco(i)
     3320
     3321      aod550_aqua(i) = aod550_aqua(i) + &
     3322              masque_aqua_cur(i) * diff_aod550_tot(i)
     3323      aod550_tr2_aqua(i) = aod550_tr2_aqua(i) + &
     3324              masque_aqua_cur(i) * diff_aod550_tr2(i)
     3325      aod550_ss_aqua(i) = aod550_ss_aqua(i) + &
     3326              masque_aqua_cur(i) * diag_aod550_ss(i)
     3327      aod550_dust_aqua(i) = aod550_dust_aqua(i) + &
     3328              masque_aqua_cur(i) * diag_aod550_dust(i)
     3329      aod550_dustsco_aqua(i) = aod550_dustsco_aqua(i) + &
     3330              masque_aqua_cur(i) * diag_aod550_dustsco(i)
     3331      aod670_aqua(i) = aod670_aqua(i) + &
     3332              masque_aqua_cur(i) * diag_aod670_tot(i)
     3333      aod670_tr2_aqua(i) = aod670_tr2_aqua(i) + &
     3334              masque_aqua_cur(i) * diag_aod670_tr2(i)
     3335      aod670_ss_aqua(i) = aod670_ss_aqua(i) + &
     3336              masque_aqua_cur(i) * diag_aod670_ss(i)
     3337      aod670_dust_aqua(i) = aod670_dust_aqua(i) + &
     3338              masque_aqua_cur(i) * diag_aod670_dust(i)
     3339      aod670_dustsco_aqua(i) = aod670_dustsco_aqua(i) + &
     3340              masque_aqua_cur(i) * diag_aod670_dustsco(i)
     3341      aod865_aqua(i) = aod865_aqua(i) + &
     3342              masque_aqua_cur(i) * diag_aod865_tot(i)
     3343      aod865_tr2_aqua(i) = aod865_tr2_aqua(i) + &
     3344              masque_aqua_cur(i) * diag_aod865_tr2(i)
     3345      aod865_ss_aqua(i) = aod865_ss_aqua(i) + &
     3346              masque_aqua_cur(i) * diag_aod865_ss(i)
     3347      aod865_dust_aqua(i) = aod865_dust_aqua(i) + &
     3348              masque_aqua_cur(i) * diag_aod865_dust(i)
     3349      aod865_dustsco_aqua(i) = aod865_dustsco_aqua(i) + &
     3350              masque_aqua_cur(i) * diag_aod865_dustsco(i)
     3351
     3352      masque_aqua(i) = masque_aqua(i) + masque_aqua_cur(i)
     3353      masque_terra(i) = masque_terra(i) + masque_terra_cur(i)
     3354    ENDDO
     3355
     3356    IF (jH_cur + pdtphys / 86400. >= 1.) THEN
     3357      !          print *,'last step of the day'
     3358      DO i = 1, klon
     3359        IF (masque_aqua(i)> 0) THEN
     3360          aod550_aqua(i) = aod550_aqua(i) / masque_aqua(i)
     3361          aod670_aqua(i) = aod670_aqua(i) / masque_aqua(i)
     3362          aod865_aqua(i) = aod865_aqua(i) / masque_aqua(i)
     3363          aod550_tr2_aqua(i) = aod550_tr2_aqua(i) / masque_aqua(i)
     3364          aod670_tr2_aqua(i) = aod670_tr2_aqua(i) / masque_aqua(i)
     3365          aod865_tr2_aqua(i) = aod865_tr2_aqua(i) / masque_aqua(i)
     3366          aod550_ss_aqua(i) = aod550_ss_aqua(i) / masque_aqua(i)
     3367          aod670_ss_aqua(i) = aod670_ss_aqua(i) / masque_aqua(i)
     3368          aod865_ss_aqua(i) = aod865_ss_aqua(i) / masque_aqua(i)
     3369          aod550_dust_aqua(i) = aod550_dust_aqua(i) / masque_aqua(i)
     3370          aod670_dust_aqua(i) = aod670_dust_aqua(i) / masque_aqua(i)
     3371          aod865_dust_aqua(i) = aod865_dust_aqua(i) / masque_aqua(i)
     3372          aod550_dustsco_aqua(i) = aod550_dustsco_aqua(i) / masque_aqua(i)
     3373          aod670_dustsco_aqua(i) = aod670_dustsco_aqua(i) / masque_aqua(i)
     3374          aod865_dustsco_aqua(i) = aod865_dustsco_aqua(i) / masque_aqua(i)
     3375        ELSE
     3376          aod550_aqua(i) = -999.
     3377          aod670_aqua(i) = -999.
     3378          aod865_aqua(i) = -999.
     3379          aod550_tr2_aqua(i) = -999.
     3380          aod670_tr2_aqua(i) = -999.
     3381          aod865_tr2_aqua(i) = -999.
     3382          aod550_ss_aqua(i) = -999.
     3383          aod670_ss_aqua(i) = -999.
     3384          aod865_ss_aqua(i) = -999.
     3385          aod550_dust_aqua(i) = -999.
     3386          aod670_dust_aqua(i) = -999.
     3387          aod865_dust_aqua(i) = -999.
     3388          aod550_dustsco_aqua(i) = -999.
     3389          aod670_dustsco_aqua(i) = -999.
     3390          aod865_dustsco_aqua(i) = -999.
     3391        ENDIF
     3392        IF (masque_terra(i)> 0) THEN
     3393          aod550_terra(i) = aod550_terra(i) / masque_terra(i)
     3394          aod670_terra(i) = aod670_terra(i) / masque_terra(i)
     3395          aod865_terra(i) = aod865_terra(i) / masque_terra(i)
     3396          aod550_tr2_terra(i) = aod550_tr2_terra(i) / masque_terra(i)
     3397          aod670_tr2_terra(i) = aod670_tr2_terra(i) / masque_terra(i)
     3398          aod865_tr2_terra(i) = aod865_tr2_terra(i) / masque_terra(i)
     3399          aod550_ss_terra(i) = aod550_ss_terra(i) / masque_terra(i)
     3400          aod670_ss_terra(i) = aod670_ss_terra(i) / masque_terra(i)
     3401          aod865_ss_terra(i) = aod865_ss_terra(i) / masque_terra(i)
     3402          aod550_dust_terra(i) = aod550_dust_terra(i) / masque_terra(i)
     3403          aod670_dust_terra(i) = aod670_dust_terra(i) / masque_terra(i)
     3404          aod865_dust_terra(i) = aod865_dust_terra(i) / masque_terra(i)
     3405          aod550_dustsco_terra(i) = aod550_dustsco_terra(i) / masque_terra(i)
     3406          aod670_dustsco_terra(i) = aod670_dustsco_terra(i) / masque_terra(i)
     3407          aod865_dustsco_terra(i) = aod865_dustsco_terra(i) / masque_terra(i)
     3408        ELSE
     3409          aod550_terra(i) = -999.
     3410          aod670_terra(i) = -999.
     3411          aod865_terra(i) = -999.
     3412          aod550_tr2_terra(i) = -999.
     3413          aod670_tr2_terra(i) = -999.
     3414          aod865_tr2_terra(i) = -999.
     3415          aod550_ss_terra(i) = -999.
     3416          aod670_ss_terra(i) = -999.
     3417          aod865_ss_terra(i) = -999.
     3418          aod550_dust_terra(i) = -999.
     3419          aod670_dust_terra(i) = -999.
     3420          aod865_dust_terra(i) = -999.
     3421          aod550_dustsco_terra(i) = -999.
     3422          aod670_dustsco_terra(i) = -999.
     3423          aod865_dustsco_terra(i) = -999.
     3424        ENDIF
     3425      ENDDO
     3426
     3427      !!AS deleting lines
     3428      !!      IF (ok_histrac) THEN
     3429      !!!!      write in output file
     3430      !!----many deleted lines
     3431      !!      ENDIF  !mpi_root
     3432      !!!$OMP END MASTER
     3433      !!!$OMP BARRIER
     3434      !!      ENDIF  !--ok_histrac
     3435
     3436    ENDIF ! jH_cur...
     3437
     3438    !======================================================================
     3439    !  Stockage sur bande histoire
     3440    !======================================================================
    35593441#ifdef IOPHYS_DUST
    35603442      do itr=1,nbtr
    … …  
    35643446#endif
    35653447
    3566 
    3567 !
    3568       IF (logitime) THEN
    3569       CALL SYSTEM_CLOCK(COUNT=clock_start)
     3448    IF (logitime) THEN
     3449      CALL SYSTEM_CLOCK(COUNT = clock_start)
     3450    ENDIF
     3451
     3452    DO itr = 1, nbtr
     3453      DO j = 1, klev
     3454        DO i = 1, klon
     3455          tmp_var(i, j) = tr_seri(i, j, itr)
     3456        ENDDO
     3457      ENDDO
     3458      CALL cm3_to_kg(pplay, t_seri, tmp_var)
     3459      DO j = 1, klev
     3460        DO i = 1, klon
     3461          tr_seri(i, j, itr) = tmp_var(i, j)
     3462        ENDDO
     3463      ENDDO
     3464    ENDDO
     3465    iscm3 = .false.
     3466
     3467
     3468    !======================================================================
     3469    !  SAVING AEROSOL RELATED VARIABLES INTO FILE
     3470    !======================================================================
     3471
     3472    ndex2d = 0
     3473    ndex3d = 0
     3474
     3475    itra = itra + 1
     3476
     3477    print *, 'SAVING VARIABLES FOR DAY ', itra
     3478
     3479    fluxbb(:) = 0.0
     3480    fluxff(:) = 0.0
     3481    fluxbcbb(:) = 0.0
     3482    fluxbcff(:) = 0.0
     3483    fluxbcnff(:) = 0.0
     3484    fluxbcba(:) = 0.0
     3485    fluxbc(:) = 0.0
     3486    fluxombb(:) = 0.0
     3487    fluxomff(:) = 0.0
     3488    fluxomnat(:) = 0.0
     3489    fluxomba(:) = 0.0
     3490    fluxomnff(:) = 0.0
     3491    fluxom(:) = 0.0
     3492    fluxh2sff(:) = 0.0
     3493    fluxh2snff(:) = 0.0
     3494    fluxh2sbio(:) = 0.0
     3495    fluxso2ff(:) = 0.0
     3496    fluxso2nff(:) = 0.0
     3497    fluxso2bb(:) = 0.0
     3498    fluxso2vol(:) = 0.0
     3499    fluxso2ba(:) = 0.0
     3500    fluxso2(:) = 0.0
     3501    fluxso4ff(:) = 0.0
     3502    fluxso4nff(:) = 0.0
     3503    fluxso4bb(:) = 0.0
     3504    fluxso4ba(:) = 0.0
     3505    fluxso4(:) = 0.0
     3506    fluxdms(:) = 0.0
     3507    fluxdustec(:) = 0.0
     3508    fluxddfine(:) = 0.0
     3509    fluxddcoa(:) = 0.0
     3510    fluxddsco(:) = 0.0
     3511    fluxdd(:) = 0.0
     3512    fluxssfine(:) = 0.0
     3513    fluxsscoa(:) = 0.0
     3514    fluxss(:) = 0.0
     3515    DO i = 1, klon
     3516      IF (iregion_ind(i)>0) THEN           ! LAND
     3517        ! SULFUR EMISSIONS
     3518        fluxh2sff(i) = (lmt_so2ff_l(i) + lmt_so2ff_h(i)) * frach2sofso2 * &
     3519                scale_param_ind(iregion_ind(i)) * &
     3520                1.e4 / RNAVO * masse_s * 1.e3         ! mgS/m2/s
     3521        fluxso2ff(i) = scale_param_ind(iregion_ind(i)) * fracso2emis * &
     3522                (lmt_so2ff_l(i) + lmt_so2ff_h(i)) * 1.e4 / RNAVO * &
     3523                masse_s * 1.e3  ! mgS/m2/s
     3524        ! SULPHATE EMISSIONS
     3525        fluxso4ff(i) = scale_param_ind(iregion_ind(i)) * (1 - fracso2emis) * &
     3526                (lmt_so2ff_l(i) + lmt_so2ff_h(i)) * 1.e4 / RNAVO * &
     3527                masse_s * 1.e3  ! mgS/m2/s
     3528        ! BLACK CARBON EMISSIONS
     3529        fluxbcff(i) = scale_param_ff(iregion_ind(i)) * &
     3530                lmt_bcff(i) * 1.e4 * 1.e3  !/g/m2/s
     3531        ! ORGANIC MATTER EMISSIONS
     3532        fluxomff(i) = scale_param_ff(iregion_ind(i)) * &
     3533                (lmt_omff(i)) * 1.e4 * 1.e3  !/g/m2/s
     3534        ! FOSSIL FUEL EMISSIONS
     3535        fluxff(i) = fluxbcff(i) + fluxomff(i)
    35703536      ENDIF
    3571 
    3572       DO itr=1,nbtr
    3573          DO j=1,klev
    3574          DO i=1,klon
    3575            tmp_var(i,j)=tr_seri(i,j,itr)
    3576          ENDDO
    3577          ENDDO
    3578          CALL cm3_to_kg(pplay,t_seri,tmp_var)
    3579          DO j=1,klev
    3580          DO i=1,klon
    3581            tr_seri(i,j,itr)=tmp_var(i,j)
    3582          ENDDO
    3583          ENDDO
    3584       ENDDO
    3585        iscm3=.false.
    3586 
    3587 !
    3588 !
    3589 !======================================================================
    3590 !  SAVING AEROSOL RELATED VARIABLES INTO FILE
    3591 !======================================================================
    3592 !
    3593       ndex2d = 0
    3594       ndex3d = 0
    3595 !
    3596       itra=itra+1
    3597 
    3598       print *,'SAVING VARIABLES FOR DAY ',itra
    3599 !
    3600       fluxbb(:)=0.0
    3601       fluxff(:)=0.0
    3602       fluxbcbb(:)=0.0
    3603       fluxbcff(:)=0.0
    3604       fluxbcnff(:)=0.0
    3605       fluxbcba(:)=0.0
    3606       fluxbc(:)=0.0
    3607       fluxombb(:)=0.0
    3608       fluxomff(:)=0.0
    3609       fluxomnat(:)=0.0
    3610       fluxomba(:)=0.0
    3611       fluxomnff(:)=0.0
    3612       fluxom(:)=0.0
    3613       fluxh2sff(:)=0.0
    3614       fluxh2snff(:)=0.0
    3615       fluxh2sbio(:)=0.0
    3616       fluxso2ff(:)=0.0
    3617       fluxso2nff(:)=0.0
    3618       fluxso2bb(:)=0.0
    3619       fluxso2vol(:)=0.0
    3620       fluxso2ba(:)=0.0
    3621       fluxso2(:)=0.0
    3622       fluxso4ff(:)=0.0
    3623       fluxso4nff(:)=0.0
    3624       fluxso4bb(:)=0.0
    3625       fluxso4ba(:)=0.0
    3626       fluxso4(:)=0.0
    3627       fluxdms(:)=0.0
    3628       fluxdustec(:)=0.0
    3629       fluxddfine(:)=0.0
    3630       fluxddcoa(:)=0.0
    3631       fluxddsco(:)=0.0
    3632       fluxdd(:)=0.0
    3633       fluxssfine(:)=0.0
    3634       fluxsscoa(:)=0.0
    3635       fluxss(:)=0.0
    3636       DO i=1, klon
    3637          IF (iregion_ind(i)>0) THEN           ! LAND
    3638            ! SULFUR EMISSIONS
    3639            fluxh2sff(i)= (lmt_so2ff_l(i)+lmt_so2ff_h(i))*frach2sofso2*  &       
    3640                          scale_param_ind(iregion_ind(i))*               &
    3641                                     1.e4/RNAVO*masse_s*1.e3         ! mgS/m2/s
    3642            fluxso2ff(i)=scale_param_ind(iregion_ind(i)) * fracso2emis * &
    3643                         (lmt_so2ff_l(i)+lmt_so2ff_h(i)) * 1.e4/RNAVO * &
    3644                                                     masse_s * 1.e3  ! mgS/m2/s
    3645            ! SULPHATE EMISSIONS
    3646            fluxso4ff(i)=scale_param_ind(iregion_ind(i))*(1-fracso2emis)* &
    3647                          (lmt_so2ff_l(i)+lmt_so2ff_h(i)) * 1.e4/RNAVO * &
    3648                                                     masse_s * 1.e3  ! mgS/m2/s
    3649            ! BLACK CARBON EMISSIONS
    3650            fluxbcff(i)=scale_param_ff(iregion_ind(i))* &
    3651                                              lmt_bcff(i)*1.e4*1.e3  !/g/m2/s
    3652            ! ORGANIC MATTER EMISSIONS
    3653            fluxomff(i)=scale_param_ff(iregion_ind(i))* &
    3654                                (lmt_omff(i))*1.e4*1.e3  !/g/m2/s
    3655            ! FOSSIL FUEL EMISSIONS
    3656            fluxff(i)=fluxbcff(i)+fluxomff(i)
    3657          ENDIF
    3658          IF (iregion_bb(i)>0) THEN           ! LAND
    3659            ! SULFUR EMISSIONS
    3660            fluxso2bb(i) =scale_param_bb(iregion_bb(i)) * fracso2emis *  &
    3661                       (lmt_so2bb_l(i)+lmt_so2bb_h(i))*                 &
    3662                 (1.-pctsrf(i,is_oce))*1.e4/RNAVO*masse_s*1.e3       ! mgS/m2/s
    3663            ! SULPHATE EMISSIONS
    3664            fluxso4bb(i) =scale_param_bb(iregion_bb(i))*(1-fracso2emis)* &
    3665                       (lmt_so2bb_l(i)+lmt_so2bb_h(i))*                 &
    3666                 (1.-pctsrf(i,is_oce))*1.e4/RNAVO*masse_s*1.e3       ! mgS/m2/s
    3667            ! BLACK CARBON EMISSIONS
    3668            fluxbcbb(i)=scale_param_bb(iregion_bb(i))*                   &
    3669                            (lmt_bcbb_l(i)+lmt_bcbb_h(i))*1.e4*1.e3  !mg/m2/s
    3670            ! ORGANIC MATTER EMISSIONS
    3671            fluxombb(i)=scale_param_bb(iregion_bb(i))*                   &
    3672                            (lmt_ombb_l(i)+lmt_ombb_h(i))*1.e4*1.e3  !mg/m2/s
    3673            ! BIOMASS BURNING EMISSIONS
    3674            fluxbb(i)=fluxbcbb(i)+fluxombb(i)
    3675          ENDIF
    3676          ! H2S EMISSIONS
    3677          fluxh2sbio(i)=lmt_h2sbio(i)*1.e4/RNAVO*masse_s*1.e3      ! mgS/m2/s
    3678          fluxh2snff(i)= lmt_so2nff(i)*frach2sofso2*  &
    3679                                     1.e4/RNAVO*masse_s*1.e3         ! mgS/m2/s
    3680          ! SULFUR DIOXIDE EMISSIONS
    3681          fluxso2nff(i)=fracso2emis * lmt_so2nff(i) * 1.e4/RNAVO *  &
    3682                                                     masse_s * 1.e3  ! mgS/m2/s
    3683          fluxso2vol(i)=(lmt_so2volc_cont(i)+lmt_so2volc_expl(i))  &
    3684                       *1.e4/RNAVO*masse_s*1.e3        ! mgS/m2/s
    3685          fluxso2ba(i) =lmt_so2ba(i)*1.e4/RNAVO*masse_s*1.e3*      &
    3686                                                         fracso2emis ! mgS/m2/s
    3687          fluxso2(i)=fluxso2ff(i)+fluxso2bb(i)+fluxso2nff(i)+   &
    3688                    fluxso2vol(i)+fluxso2ba(i)
    3689          ! DMS EMISSIONS
    3690          fluxdms(i)=( lmt_dms(i)+lmt_dmsbio(i) )              &
    3691                    *1.e4/RNAVO*masse_s*1.e3          ! mgS/m2/s
    3692          ! SULPHATE EMISSIONS
    3693          fluxso4ba(i) =lmt_so2ba(i)*1.e4/RNAVO*masse_s*1.e3        &
    3694                       *(1-fracso2emis) ! mgS/m2/s
    3695          fluxso4nff(i)=(1-fracso2emis)*lmt_so2nff(i) * 1.e4/RNAVO *  &
    3696                                                     masse_s * 1.e3  ! mgS/m2/s
    3697          fluxso4(i)=fluxso4ff(i)+fluxso4bb(i)+fluxso4ba(i)+fluxso4nff(i)
    3698          ! BLACK CARBON EMISSIONS
    3699 
    3700          fluxbcnff(i)=lmt_bcnff(i)*1.e4*1.e3  !mg/m2/s
    3701          fluxbcba(i)=lmt_bcba(i)*1.e4*1.e3    !mg/m2/s
    3702          fluxbc(i)=fluxbcbb(i)+fluxbcff(i)+fluxbcnff(i)+fluxbcba(i)
    3703          ! ORGANIC MATTER EMISSIONS
    3704          fluxomnat(i)=lmt_omnat(i)*1.e4*1.e3  !mg/m2/s
    3705          fluxomba(i)=lmt_omba(i)*1.e4*1.e3  !mg/m2/s
    3706          fluxomnff(i)=lmt_omnff(i)*1.e4*1.e3  !mg/m2/s
    3707          fluxom(i)=fluxombb(i)+fluxomff(i)+fluxomnat(i)+fluxomba(i)+  &
    3708                   fluxomnff(i)
    3709         ! DUST EMISSIONS
    3710          fluxdustec(i)=dust_ec(i)*1.e6 ! old dust emission scheme
    3711 !JE20140605<<         old dust emission version
    3712 !         fluxddfine(i)=scale_param_dustacc(iregion_dust(i))
    3713 !     .                                  * dust_ec(i)*0.093*1.e6
    3714 !         fluxddcoa(i)=scale_param_dustcoa(iregion_dust(i))
    3715 !     .                                  * dust_ec(i)*0.905*1.e6
    3716 !         fluxdd(i)=fluxddfine(i)+fluxddcoa(i)
    3717 !JE20140605>>
    3718          fluxddfine(i)=flux_sparam_ddfine(i)
    3719          fluxddcoa(i)=flux_sparam_ddcoa(i)
    3720          fluxddsco(i)=flux_sparam_ddsco(i)
    3721          fluxdd(i)=fluxddfine(i)+fluxddcoa(i)+fluxddsco(i)
    3722         ! SEA SALT EMISSIONS
    3723          fluxssfine(i)=scale_param_ssacc*lmt_sea_salt(i,1)*1.e4*1.e3
    3724          fluxsscoa(i)=scale_param_sscoa*lmt_sea_salt(i,2)*1.e4*1.e3
    3725          fluxss(i)=fluxssfine(i)+fluxsscoa(i)
    3726       ENDDO
    3727 
    3728 !      prepare outputs cvltr
    3729 
    3730       DO itr=1,nbtr
    3731         DO k=1,klev
    3732         DO i=1,klon
    3733            tmp_var(i,k)=d_tr_cv(i,k,itr)
    3734         ENDDO
    3735         ENDDO
    3736         CALL kg_to_cm3(pplay,t_seri,tmp_var)
    3737        DO k=1,klev
    3738         DO i=1,klon
    3739           d_tr_cv_o(i,k,itr)=tmp_var(i,k)  &
    3740                          /RNAVO*masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys 
    3741         ENDDO
    3742        ENDDO
    3743       ENDDO
    3744       DO itr=1,nbtr
    3745         DO k=1,klev
    3746         DO i=1,klon
    3747            tmp_var(i,k)=d_tr_trsp(i,k,itr)
    3748         ENDDO
    3749         ENDDO
    3750         CALL kg_to_cm3(pplay,t_seri,tmp_var)
    3751        DO k=1,klev
    3752         DO i=1,klon
    3753           d_tr_trsp_o(i,k,itr)=tmp_var(i,k)  &
    3754                          /RNAVO*masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys 
    3755         ENDDO
    3756        ENDDO
    3757       ENDDO
    3758       DO itr=1,nbtr
    3759         DO k=1,klev
    3760         DO i=1,klon
    3761            tmp_var(i,k)=d_tr_sscav(i,k,itr)
    3762         ENDDO
    3763         ENDDO
    3764         CALL kg_to_cm3(pplay,t_seri,tmp_var)
    3765        DO k=1,klev
    3766         DO i=1,klon
    3767           d_tr_sscav_o(i,k,itr)=tmp_var(i,k)  &
    3768                          /RNAVO*masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys 
    3769         ENDDO
    3770        ENDDO
    3771       ENDDO
    3772       DO itr=1,nbtr
    3773         DO k=1,klev
    3774         DO i=1,klon
    3775            tmp_var(i,k)=d_tr_sat(i,k,itr)
    3776         ENDDO
    3777         ENDDO
    3778         CALL kg_to_cm3(pplay,t_seri,tmp_var)
    3779        DO k=1,klev
    3780         DO i=1,klon
    3781           d_tr_sat_o(i,k,itr)=tmp_var(i,k)   &
    3782                          /RNAVO*masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys 
    3783         ENDDO
    3784        ENDDO
    3785       ENDDO
    3786       DO itr=1,nbtr
    3787         DO k=1,klev
    3788         DO i=1,klon
    3789            tmp_var(i,k)=d_tr_uscav(i,k,itr)
    3790         ENDDO
    3791         ENDDO
    3792         CALL kg_to_cm3(pplay,t_seri,tmp_var)
    3793        DO k=1,klev
    3794         DO i=1,klon
    3795           d_tr_uscav_o(i,k,itr)=tmp_var(i,k)  &
    3796                          /RNAVO*masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys 
    3797         ENDDO
    3798        ENDDO
    3799       ENDDO
    3800 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    3801      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    3802       DO itr=1,nbtr
    3803         DO k=1,klev
    3804         DO i=1,klon
    3805            tmp_var(i,k)=d_tr_insc(i,k,itr)
    3806         ENDDO
    3807         ENDDO
    3808         CALL kg_to_cm3(pplay,t_seri,tmp_var)
    3809        DO k=1,klev
    3810         DO i=1,klon
    3811           d_tr_insc_o(i,k,itr)=tmp_var(i,k)  &
    3812                          /RNAVO*masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys 
    3813         ENDDO
    3814        ENDDO
    3815       ENDDO
    3816      
    3817 
    3818       DO itr=1,nbtr
    3819         DO k=1,klev
    3820         DO i=1,klon
    3821            tmp_var(i,k)=d_tr_bcscav(i,k,itr)
    3822         ENDDO
    3823         ENDDO
    3824         CALL kg_to_cm3(pplay,t_seri,tmp_var)
    3825        DO k=1,klev
    3826         DO i=1,klon
    3827           d_tr_bcscav_o(i,k,itr)=tmp_var(i,k)  &
    3828                          /RNAVO*masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys 
    3829         ENDDO
    3830        ENDDO
    3831       ENDDO
    3832 
    3833 
    3834       DO itr=1,nbtr
    3835         DO k=1,klev
    3836         DO i=1,klon
    3837            tmp_var(i,k)=d_tr_evapls(i,k,itr)
    3838         ENDDO
    3839         ENDDO
    3840         CALL kg_to_cm3(pplay,t_seri,tmp_var)
    3841        DO k=1,klev
    3842         DO i=1,klon
    3843           d_tr_evapls_o(i,k,itr)=tmp_var(i,k)  &
    3844                          /RNAVO*masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys 
    3845         ENDDO
    3846        ENDDO
    3847       ENDDO
    3848 
    3849 
    3850       DO itr=1,nbtr
    3851         DO k=1,klev
    3852         DO i=1,klon
    3853            tmp_var(i,k)=d_tr_ls(i,k,itr)
    3854         ENDDO
    3855         ENDDO
    3856         CALL kg_to_cm3(pplay,t_seri,tmp_var)
    3857        DO k=1,klev
    3858         DO i=1,klon
    3859           d_tr_ls_o(i,k,itr)=tmp_var(i,k)  &
    3860                          /RNAVO*masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys 
    3861         ENDDO
    3862        ENDDO
    3863       ENDDO
    3864 
    3865 
    3866       DO itr=1,nbtr
    3867         DO k=1,klev
    3868         DO i=1,klon
    3869            tmp_var(i,k)=d_tr_dyn(i,k,itr)
    3870         ENDDO
    3871         ENDDO
    3872         CALL kg_to_cm3(pplay,t_seri,tmp_var)
    3873        DO k=1,klev
    3874         DO i=1,klon
    3875           d_tr_dyn_o(i,k,itr)=tmp_var(i,k)  &
    3876                          /RNAVO*masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys 
    3877         ENDDO
    3878        ENDDO
    3879       ENDDO
    3880 
    3881 
    3882       DO itr=1,nbtr
    3883         DO k=1,klev
    3884         DO i=1,klon
    3885            tmp_var(i,k)=d_tr_cl(i,k,itr)
    3886         ENDDO
    3887         ENDDO
    3888         CALL kg_to_cm3(pplay,t_seri,tmp_var)
    3889        DO k=1,klev
    3890         DO i=1,klon
    3891           d_tr_cl_o(i,k,itr)=tmp_var(i,k)  &
    3892                          /RNAVO*masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys 
    3893         ENDDO
    3894        ENDDO
    3895       ENDDO
    3896 
    3897 
    3898       DO itr=1,nbtr
    3899         DO k=1,klev
    3900         DO i=1,klon
    3901            tmp_var(i,k)=d_tr_th(i,k,itr)
    3902         ENDDO
    3903         ENDDO
    3904         CALL kg_to_cm3(pplay,t_seri,tmp_var)
    3905        DO k=1,klev
    3906         DO i=1,klon
    3907           d_tr_th_o(i,k,itr)=tmp_var(i,k)  &
    3908                          /RNAVO*masse(itr)*1.e3*1.e6*zdz(i,k)/pdtphys 
    3909         ENDDO
    3910        ENDDO
    3911       ENDDO
    3912      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    3913 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    3914 
    3915      DO itr=1,nbtr
    3916       WRITE(str2,'(i2.2)') itr
    3917        DO i=1, klon                                                       
    3918         his_dh(i,itr)= his_dhlsc(i,itr)+his_dhcon(i,itr)+               &
    3919                    his_dhbclsc(i,itr)+his_dhbccon(i,itr)
    3920 
    3921        ENDDO
    3922       ENDDO
    3923 
    3924 !AS: commenting out and deleting lines
    3925 !!      IF (ok_histrac) THEN
    3926 !!
    3927 !! SAVING VARIABLES IN TRACEUR
    3928 !!----- many lines deleted----
    3929 !!      ENDIF ! ok_histrac                                                   
    3930                                                                            
    3931 
    3932 
    3933 
    3934 !JE20141224
    3935 ! saving variables for output
    3936 ! 2D outputs
    3937       DO i=1, klon
    3938        trm01(i)=0.
    3939        trm02(i)=0.
    3940        trm03(i)=0.
    3941        trm04(i)=0.
    3942        trm05(i)=0.
    3943        sconc01(i)=0.
    3944        sconc02(i)=0.
    3945        sconc03(i)=0.
    3946        sconc04(i)=0.
    3947        sconc05(i)=0.
    3948        flux01(i)=0.
    3949        flux02(i)=0.
    3950        flux03(i)=0.
    3951        flux04(i)=0.
    3952        flux05(i)=0.
    3953        ds01(i)=0.
    3954        ds02(i)=0.
    3955        ds03(i)=0.
    3956        ds04(i)=0.
    3957        ds05(i)=0.
    3958        dh01(i)=0.
    3959        dh02(i)=0.
    3960        dh03(i)=0.
    3961        dh04(i)=0.
    3962        dh05(i)=0.
    3963        dtrconv01(i)=0.
    3964        dtrconv02(i)=0.
    3965        dtrconv03(i)=0.
    3966        dtrconv04(i)=0.
    3967        dtrconv05(i)=0.
    3968        dtherm01(i)=0.
    3969        dtherm02(i)=0.
    3970        dtherm03(i)=0.
    3971        dtherm04(i)=0.
    3972        dtherm05(i)=0.
    3973        dhkecv01(i)=0.
    3974        dhkecv02(i)=0.
    3975        dhkecv03(i)=0.
    3976        dhkecv04(i)=0.
    3977        dhkecv05(i)=0.
    3978        d_tr_ds01(i)=0.
    3979        d_tr_ds02(i)=0.
    3980        d_tr_ds03(i)=0.
    3981        d_tr_ds04(i)=0.
    3982        d_tr_ds05(i)=0.
    3983        dhkelsc01(i)=0.
    3984        dhkelsc02(i)=0.
    3985        dhkelsc03(i)=0.
    3986        dhkelsc04(i)=0.
    3987        dhkelsc05(i)=0.
    3988 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    3989 
    3990       if(id_prec>0)  trm01(i)=trm(i,id_prec)
    3991       if(id_fine>0)  trm02(i)=trm(i,id_fine)
    3992       if(id_coss>0)  trm03(i)=trm(i,id_coss)
    3993       if(id_codu>0)  trm04(i)=trm(i,id_codu)
    3994       if(id_scdu>0)  trm05(i)=trm(i,id_scdu)
    3995       if(id_prec>0)    sconc01(i)=sconc_seri(i,id_prec)
    3996       if(id_fine>0)    sconc02(i)=sconc_seri(i,id_fine)
    3997       if(id_coss>0)    sconc03(i)=sconc_seri(i,id_coss)
    3998       if(id_codu>0)    sconc04(i)=sconc_seri(i,id_codu)
    3999       if(id_scdu>0)    sconc05(i)=sconc_seri(i,id_scdu)
    4000       if(id_prec>0)    flux01(i)=flux_tr(i,id_prec)
    4001       if(id_fine>0)    flux02(i)=flux_tr(i,id_fine)
    4002       if(id_coss>0)    flux03(i)=flux_tr(i,id_coss)
    4003       if(id_codu>0)    flux04(i)=flux_tr(i,id_codu)
    4004       if(id_scdu>0)    flux05(i)=flux_tr(i,id_scdu)
    4005       if(id_prec>0)    ds01(i)=his_ds(i,id_prec)
    4006       if(id_fine>0)    ds02(i)=his_ds(i,id_fine)
    4007       if(id_coss>0)    ds03(i)=his_ds(i,id_coss)
    4008       if(id_codu>0)    ds04(i)=his_ds(i,id_codu)
    4009       if(id_scdu>0)    ds05(i)=his_ds(i,id_scdu)
    4010       if(id_prec>0)    dh01(i)=his_dh(i,id_prec)
    4011       if(id_fine>0)    dh02(i)=his_dh(i,id_fine)
    4012       if(id_coss>0)    dh03(i)=his_dh(i,id_coss)
    4013       if(id_codu>0)    dh04(i)=his_dh(i,id_codu)
    4014       if(id_scdu>0)    dh05(i)=his_dh(i,id_scdu)
    4015       if(id_prec>0)    dtrconv01(i)=dtrconv(i,id_prec)
    4016       if(id_fine>0)    dtrconv02(i)=dtrconv(i,id_fine)
    4017       if(id_coss>0)    dtrconv03(i)=dtrconv(i,id_coss)
    4018       if(id_codu>0)    dtrconv04(i)=dtrconv(i,id_codu)
    4019       if(id_scdu>0)    dtrconv05(i)=dtrconv(i,id_scdu)
    4020       if(id_prec>0)    dtherm01(i)=his_th(i,id_prec)
    4021       if(id_fine>0)    dtherm02(i)=his_th(i,id_fine)
    4022       if(id_coss>0)    dtherm03(i)=his_th(i,id_coss)
    4023       if(id_codu>0)    dtherm04(i)=his_th(i,id_codu)
    4024       if(id_scdu>0)    dtherm05(i)=his_th(i,id_scdu)
    4025       if(id_prec>0)    dhkecv01(i)=his_dhkecv(i,id_prec)
    4026       if(id_fine>0)    dhkecv02(i)=his_dhkecv(i,id_fine)
    4027       if(id_coss>0)    dhkecv03(i)=his_dhkecv(i,id_coss)
    4028       if(id_codu>0)    dhkecv04(i)=his_dhkecv(i,id_codu)
    4029       if(id_scdu>0)    dhkecv05(i)=his_dhkecv(i,id_scdu)
    4030       if(id_prec>0)    d_tr_ds01(i)=his_ds(i,id_prec)
    4031       if(id_fine>0)    d_tr_ds02(i)=his_ds(i,id_fine)
    4032       if(id_coss>0)    d_tr_ds03(i)=his_ds(i,id_coss)
    4033       if(id_codu>0)    d_tr_ds04(i)=his_ds(i,id_codu)
    4034       if(id_scdu>0)    d_tr_ds05(i)=his_ds(i,id_scdu)
    4035       if(id_prec>0)    dhkelsc01(i)=his_dhkelsc(i,id_prec)
    4036       if(id_fine>0)    dhkelsc02(i)=his_dhkelsc(i,id_fine)
    4037       if(id_coss>0)    dhkelsc03(i)=his_dhkelsc(i,id_coss)
    4038       if(id_codu>0)    dhkelsc04(i)=his_dhkelsc(i,id_codu)
    4039       if(id_scdu>0)    dhkelsc05(i)=his_dhkelsc(i,id_scdu)
    4040        u10m_ss(i)=u10m_ec(i)
    4041        v10m_ss(i)=v10m_ec(i)
    4042       ENDDO
    4043 ! 3D outs
    4044       DO i=1, klon
    4045         DO k=1,klev
    4046       d_tr_cv01(i,k)   =0.
    4047       d_tr_cv02(i,k)   =0.
    4048       d_tr_cv03(i,k)   =0.
    4049       d_tr_cv04(i,k)   =0.
    4050       d_tr_cv05(i,k)   =0.
    4051       d_tr_trsp01(i,k) =0.
    4052       d_tr_trsp02(i,k) =0.
    4053       d_tr_trsp03(i,k) =0.
    4054       d_tr_trsp04(i,k) =0.
    4055       d_tr_trsp05(i,k) =0.
    4056       d_tr_sscav01(i,k)=0.
    4057       d_tr_sscav02(i,k)=0.
    4058       d_tr_sscav03(i,k)=0.
    4059       d_tr_sscav04(i,k)=0.
    4060       d_tr_sscav05(i,k)=0.
    4061       d_tr_sat01(i,k)  =0.
    4062       d_tr_sat02(i,k)  =0.
    4063       d_tr_sat03(i,k)  =0.
    4064       d_tr_sat04(i,k)  =0.
    4065       d_tr_sat05(i,k)  =0.
    4066       d_tr_uscav01(i,k)=0.
    4067       d_tr_uscav02(i,k)=0.
    4068       d_tr_uscav03(i,k)=0.
    4069       d_tr_uscav04(i,k)=0.
    4070       d_tr_uscav05(i,k)=0.
    4071       d_tr_insc01(i,k)=0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    4072       d_tr_insc02(i,k)=0.
    4073       d_tr_insc03(i,k)=0.
    4074       d_tr_insc04(i,k)=0.
    4075       d_tr_insc05(i,k)=0.
    4076       d_tr_bcscav01(i,k)=0.
    4077       d_tr_bcscav02(i,k)=0.
    4078       d_tr_bcscav03(i,k)=0.
    4079       d_tr_bcscav04(i,k)=0.
    4080       d_tr_bcscav05(i,k)=0.
    4081       d_tr_evapls01(i,k)=0.
    4082       d_tr_evapls02(i,k)=0.
    4083       d_tr_evapls03(i,k)=0.
    4084       d_tr_evapls04(i,k)=0.
    4085       d_tr_evapls05(i,k)=0.
    4086       d_tr_ls01(i,k)=0.
    4087       d_tr_ls02(i,k)=0.
    4088       d_tr_ls03(i,k)=0.
    4089       d_tr_ls04(i,k)=0.
    4090       d_tr_ls05(i,k)=0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    4091       d_tr_dyn01(i,k)=0.
    4092       d_tr_dyn02(i,k)=0.
    4093       d_tr_dyn03(i,k)=0.
    4094       d_tr_dyn04(i,k)=0.
    4095       d_tr_dyn05(i,k)=0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    4096       d_tr_cl01(i,k)=0.
    4097       d_tr_cl02(i,k)=0.
    4098       d_tr_cl03(i,k)=0.
    4099       d_tr_cl04(i,k)=0.
    4100       d_tr_cl05(i,k)=0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    4101       d_tr_th01(i,k)=0.
    4102       d_tr_th02(i,k)=0.
    4103       d_tr_th03(i,k)=0.
    4104       d_tr_th04(i,k)=0.
    4105       d_tr_th05(i,k)=0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    4106         ENDDO
    4107       ENDDO
    4108 
    4109       IF(1==0) THEN
     3537      IF (iregion_bb(i)>0) THEN           ! LAND
     3538        ! SULFUR EMISSIONS
     3539        fluxso2bb(i) = scale_param_bb(iregion_bb(i)) * fracso2emis * &
     3540                (lmt_so2bb_l(i) + lmt_so2bb_h(i)) * &
     3541                (1. - pctsrf(i, is_oce)) * 1.e4 / RNAVO * masse_s * 1.e3       ! mgS/m2/s
     3542        ! SULPHATE EMISSIONS
     3543        fluxso4bb(i) = scale_param_bb(iregion_bb(i)) * (1 - fracso2emis) * &
     3544                (lmt_so2bb_l(i) + lmt_so2bb_h(i)) * &
     3545                (1. - pctsrf(i, is_oce)) * 1.e4 / RNAVO * masse_s * 1.e3       ! mgS/m2/s
     3546        ! BLACK CARBON EMISSIONS
     3547        fluxbcbb(i) = scale_param_bb(iregion_bb(i)) * &
     3548                (lmt_bcbb_l(i) + lmt_bcbb_h(i)) * 1.e4 * 1.e3  !mg/m2/s
     3549        ! ORGANIC MATTER EMISSIONS
     3550        fluxombb(i) = scale_param_bb(iregion_bb(i)) * &
     3551                (lmt_ombb_l(i) + lmt_ombb_h(i)) * 1.e4 * 1.e3  !mg/m2/s
     3552        ! BIOMASS BURNING EMISSIONS
     3553        fluxbb(i) = fluxbcbb(i) + fluxombb(i)
     3554      ENDIF
     3555      ! H2S EMISSIONS
     3556      fluxh2sbio(i) = lmt_h2sbio(i) * 1.e4 / RNAVO * masse_s * 1.e3      ! mgS/m2/s
     3557      fluxh2snff(i) = lmt_so2nff(i) * frach2sofso2 * &
     3558              1.e4 / RNAVO * masse_s * 1.e3         ! mgS/m2/s
     3559      ! SULFUR DIOXIDE EMISSIONS
     3560      fluxso2nff(i) = fracso2emis * lmt_so2nff(i) * 1.e4 / RNAVO * &
     3561              masse_s * 1.e3  ! mgS/m2/s
     3562      fluxso2vol(i) = (lmt_so2volc_cont(i) + lmt_so2volc_expl(i))  &
     3563              * 1.e4 / RNAVO * masse_s * 1.e3        ! mgS/m2/s
     3564      fluxso2ba(i) = lmt_so2ba(i) * 1.e4 / RNAVO * masse_s * 1.e3 * &
     3565              fracso2emis ! mgS/m2/s
     3566      fluxso2(i) = fluxso2ff(i) + fluxso2bb(i) + fluxso2nff(i) + &
     3567              fluxso2vol(i) + fluxso2ba(i)
     3568      ! DMS EMISSIONS
     3569      fluxdms(i) = (lmt_dms(i) + lmt_dmsbio(i))              &
     3570              * 1.e4 / RNAVO * masse_s * 1.e3          ! mgS/m2/s
     3571      ! SULPHATE EMISSIONS
     3572      fluxso4ba(i) = lmt_so2ba(i) * 1.e4 / RNAVO * masse_s * 1.e3        &
     3573              * (1 - fracso2emis) ! mgS/m2/s
     3574      fluxso4nff(i) = (1 - fracso2emis) * lmt_so2nff(i) * 1.e4 / RNAVO * &
     3575              masse_s * 1.e3  ! mgS/m2/s
     3576      fluxso4(i) = fluxso4ff(i) + fluxso4bb(i) + fluxso4ba(i) + fluxso4nff(i)
     3577      ! BLACK CARBON EMISSIONS
     3578
     3579      fluxbcnff(i) = lmt_bcnff(i) * 1.e4 * 1.e3  !mg/m2/s
     3580      fluxbcba(i) = lmt_bcba(i) * 1.e4 * 1.e3    !mg/m2/s
     3581      fluxbc(i) = fluxbcbb(i) + fluxbcff(i) + fluxbcnff(i) + fluxbcba(i)
     3582      ! ORGANIC MATTER EMISSIONS
     3583      fluxomnat(i) = lmt_omnat(i) * 1.e4 * 1.e3  !mg/m2/s
     3584      fluxomba(i) = lmt_omba(i) * 1.e4 * 1.e3  !mg/m2/s
     3585      fluxomnff(i) = lmt_omnff(i) * 1.e4 * 1.e3  !mg/m2/s
     3586      fluxom(i) = fluxombb(i) + fluxomff(i) + fluxomnat(i) + fluxomba(i) + &
     3587              fluxomnff(i)
     3588      ! DUST EMISSIONS
     3589      fluxdustec(i) = dust_ec(i) * 1.e6 ! old dust emission scheme
     3590      !JE20140605<<         old dust emission version
     3591      !         fluxddfine(i)=scale_param_dustacc(iregion_dust(i))
     3592      !     .                                  * dust_ec(i)*0.093*1.e6
     3593      !         fluxddcoa(i)=scale_param_dustcoa(iregion_dust(i))
     3594      !     .                                  * dust_ec(i)*0.905*1.e6
     3595      !         fluxdd(i)=fluxddfine(i)+fluxddcoa(i)
     3596      !JE20140605>>
     3597      fluxddfine(i) = flux_sparam_ddfine(i)
     3598      fluxddcoa(i) = flux_sparam_ddcoa(i)
     3599      fluxddsco(i) = flux_sparam_ddsco(i)
     3600      fluxdd(i) = fluxddfine(i) + fluxddcoa(i) + fluxddsco(i)
     3601      ! SEA SALT EMISSIONS
     3602      fluxssfine(i) = scale_param_ssacc * lmt_sea_salt(i, 1) * 1.e4 * 1.e3
     3603      fluxsscoa(i) = scale_param_sscoa * lmt_sea_salt(i, 2) * 1.e4 * 1.e3
     3604      fluxss(i) = fluxssfine(i) + fluxsscoa(i)
     3605    ENDDO
     3606
     3607    !      prepare outputs cvltr
     3608
     3609    DO itr = 1, nbtr
     3610      DO k = 1, klev
     3611        DO i = 1, klon
     3612          tmp_var(i, k) = d_tr_cv(i, k, itr)
     3613        ENDDO
     3614      ENDDO
     3615      CALL kg_to_cm3(pplay, t_seri, tmp_var)
     3616      DO k = 1, klev
     3617        DO i = 1, klon
     3618          d_tr_cv_o(i, k, itr) = tmp_var(i, k)  &
     3619                  / RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     3620        ENDDO
     3621      ENDDO
     3622    ENDDO
     3623    DO itr = 1, nbtr
     3624      DO k = 1, klev
     3625        DO i = 1, klon
     3626          tmp_var(i, k) = d_tr_trsp(i, k, itr)
     3627        ENDDO
     3628      ENDDO
     3629      CALL kg_to_cm3(pplay, t_seri, tmp_var)
     3630      DO k = 1, klev
     3631        DO i = 1, klon
     3632          d_tr_trsp_o(i, k, itr) = tmp_var(i, k)  &
     3633                  / RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     3634        ENDDO
     3635      ENDDO
     3636    ENDDO
     3637    DO itr = 1, nbtr
     3638      DO k = 1, klev
     3639        DO i = 1, klon
     3640          tmp_var(i, k) = d_tr_sscav(i, k, itr)
     3641        ENDDO
     3642      ENDDO
     3643      CALL kg_to_cm3(pplay, t_seri, tmp_var)
     3644      DO k = 1, klev
     3645        DO i = 1, klon
     3646          d_tr_sscav_o(i, k, itr) = tmp_var(i, k)  &
     3647                  / RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     3648        ENDDO
     3649      ENDDO
     3650    ENDDO
     3651    DO itr = 1, nbtr
     3652      DO k = 1, klev
     3653        DO i = 1, klon
     3654          tmp_var(i, k) = d_tr_sat(i, k, itr)
     3655        ENDDO
     3656      ENDDO
     3657      CALL kg_to_cm3(pplay, t_seri, tmp_var)
     3658      DO k = 1, klev
     3659        DO i = 1, klon
     3660          d_tr_sat_o(i, k, itr) = tmp_var(i, k)   &
     3661                  / RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     3662        ENDDO
     3663      ENDDO
     3664    ENDDO
     3665    DO itr = 1, nbtr
     3666      DO k = 1, klev
     3667        DO i = 1, klon
     3668          tmp_var(i, k) = d_tr_uscav(i, k, itr)
     3669        ENDDO
     3670      ENDDO
     3671      CALL kg_to_cm3(pplay, t_seri, tmp_var)
     3672      DO k = 1, klev
     3673        DO i = 1, klon
     3674          d_tr_uscav_o(i, k, itr) = tmp_var(i, k)  &
     3675                  / RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     3676        ENDDO
     3677      ENDDO
     3678    ENDDO
     3679    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     3680    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     3681    DO itr = 1, nbtr
     3682      DO k = 1, klev
     3683        DO i = 1, klon
     3684          tmp_var(i, k) = d_tr_insc(i, k, itr)
     3685        ENDDO
     3686      ENDDO
     3687      CALL kg_to_cm3(pplay, t_seri, tmp_var)
     3688      DO k = 1, klev
     3689        DO i = 1, klon
     3690          d_tr_insc_o(i, k, itr) = tmp_var(i, k)  &
     3691                  / RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     3692        ENDDO
     3693      ENDDO
     3694    ENDDO
     3695
     3696    DO itr = 1, nbtr
     3697      DO k = 1, klev
     3698        DO i = 1, klon
     3699          tmp_var(i, k) = d_tr_bcscav(i, k, itr)
     3700        ENDDO
     3701      ENDDO
     3702      CALL kg_to_cm3(pplay, t_seri, tmp_var)
     3703      DO k = 1, klev
     3704        DO i = 1, klon
     3705          d_tr_bcscav_o(i, k, itr) = tmp_var(i, k)  &
     3706                  / RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     3707        ENDDO
     3708      ENDDO
     3709    ENDDO
     3710
     3711    DO itr = 1, nbtr
     3712      DO k = 1, klev
     3713        DO i = 1, klon
     3714          tmp_var(i, k) = d_tr_evapls(i, k, itr)
     3715        ENDDO
     3716      ENDDO
     3717      CALL kg_to_cm3(pplay, t_seri, tmp_var)
     3718      DO k = 1, klev
     3719        DO i = 1, klon
     3720          d_tr_evapls_o(i, k, itr) = tmp_var(i, k)  &
     3721                  / RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     3722        ENDDO
     3723      ENDDO
     3724    ENDDO
     3725
     3726    DO itr = 1, nbtr
     3727      DO k = 1, klev
     3728        DO i = 1, klon
     3729          tmp_var(i, k) = d_tr_ls(i, k, itr)
     3730        ENDDO
     3731      ENDDO
     3732      CALL kg_to_cm3(pplay, t_seri, tmp_var)
     3733      DO k = 1, klev
     3734        DO i = 1, klon
     3735          d_tr_ls_o(i, k, itr) = tmp_var(i, k)  &
     3736                  / RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     3737        ENDDO
     3738      ENDDO
     3739    ENDDO
     3740
     3741    DO itr = 1, nbtr
     3742      DO k = 1, klev
     3743        DO i = 1, klon
     3744          tmp_var(i, k) = d_tr_dyn(i, k, itr)
     3745        ENDDO
     3746      ENDDO
     3747      CALL kg_to_cm3(pplay, t_seri, tmp_var)
     3748      DO k = 1, klev
     3749        DO i = 1, klon
     3750          d_tr_dyn_o(i, k, itr) = tmp_var(i, k)  &
     3751                  / RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     3752        ENDDO
     3753      ENDDO
     3754    ENDDO
     3755
     3756    DO itr = 1, nbtr
     3757      DO k = 1, klev
     3758        DO i = 1, klon
     3759          tmp_var(i, k) = d_tr_cl(i, k, itr)
     3760        ENDDO
     3761      ENDDO
     3762      CALL kg_to_cm3(pplay, t_seri, tmp_var)
     3763      DO k = 1, klev
     3764        DO i = 1, klon
     3765          d_tr_cl_o(i, k, itr) = tmp_var(i, k)  &
     3766                  / RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     3767        ENDDO
     3768      ENDDO
     3769    ENDDO
     3770
     3771    DO itr = 1, nbtr
     3772      DO k = 1, klev
     3773        DO i = 1, klon
     3774          tmp_var(i, k) = d_tr_th(i, k, itr)
     3775        ENDDO
     3776      ENDDO
     3777      CALL kg_to_cm3(pplay, t_seri, tmp_var)
     3778      DO k = 1, klev
     3779        DO i = 1, klon
     3780          d_tr_th_o(i, k, itr) = tmp_var(i, k)  &
     3781                  / RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
     3782        ENDDO
     3783      ENDDO
     3784    ENDDO
     3785    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     3786    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     3787
     3788    DO itr = 1, nbtr
     3789      WRITE(str2, '(i2.2)') itr
     3790      DO i = 1, klon
     3791        his_dh(i, itr) = his_dhlsc(i, itr) + his_dhcon(i, itr) + &
     3792                his_dhbclsc(i, itr) + his_dhbccon(i, itr)
     3793
     3794      ENDDO
     3795    ENDDO
     3796
     3797    !AS: commenting out and deleting lines
     3798    !!      IF (ok_histrac) THEN
     3799    !!
     3800    !! SAVING VARIABLES IN TRACEUR
     3801    !!----- many lines deleted----
     3802    !!      ENDIF ! ok_histrac
     3803
     3804
     3805
     3806
     3807    !JE20141224
     3808    ! saving variables for output
     3809    ! 2D outputs
     3810    DO i = 1, klon
     3811      trm01(i) = 0.
     3812      trm02(i) = 0.
     3813      trm03(i) = 0.
     3814      trm04(i) = 0.
     3815      trm05(i) = 0.
     3816      sconc01(i) = 0.
     3817      sconc02(i) = 0.
     3818      sconc03(i) = 0.
     3819      sconc04(i) = 0.
     3820      sconc05(i) = 0.
     3821      flux01(i) = 0.
     3822      flux02(i) = 0.
     3823      flux03(i) = 0.
     3824      flux04(i) = 0.
     3825      flux05(i) = 0.
     3826      ds01(i) = 0.
     3827      ds02(i) = 0.
     3828      ds03(i) = 0.
     3829      ds04(i) = 0.
     3830      ds05(i) = 0.
     3831      dh01(i) = 0.
     3832      dh02(i) = 0.
     3833      dh03(i) = 0.
     3834      dh04(i) = 0.
     3835      dh05(i) = 0.
     3836      dtrconv01(i) = 0.
     3837      dtrconv02(i) = 0.
     3838      dtrconv03(i) = 0.
     3839      dtrconv04(i) = 0.
     3840      dtrconv05(i) = 0.
     3841      dtherm01(i) = 0.
     3842      dtherm02(i) = 0.
     3843      dtherm03(i) = 0.
     3844      dtherm04(i) = 0.
     3845      dtherm05(i) = 0.
     3846      dhkecv01(i) = 0.
     3847      dhkecv02(i) = 0.
     3848      dhkecv03(i) = 0.
     3849      dhkecv04(i) = 0.
     3850      dhkecv05(i) = 0.
     3851      d_tr_ds01(i) = 0.
     3852      d_tr_ds02(i) = 0.
     3853      d_tr_ds03(i) = 0.
     3854      d_tr_ds04(i) = 0.
     3855      d_tr_ds05(i) = 0.
     3856      dhkelsc01(i) = 0.
     3857      dhkelsc02(i) = 0.
     3858      dhkelsc03(i) = 0.
     3859      dhkelsc04(i) = 0.
     3860      dhkelsc05(i) = 0.
     3861      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     3862
     3863      if(id_prec>0)  trm01(i) = trm(i, id_prec)
     3864      if(id_fine>0)  trm02(i) = trm(i, id_fine)
     3865      if(id_coss>0)  trm03(i) = trm(i, id_coss)
     3866      if(id_codu>0)  trm04(i) = trm(i, id_codu)
     3867      if(id_scdu>0)  trm05(i) = trm(i, id_scdu)
     3868      if(id_prec>0)    sconc01(i) = sconc_seri(i, id_prec)
     3869      if(id_fine>0)    sconc02(i) = sconc_seri(i, id_fine)
     3870      if(id_coss>0)    sconc03(i) = sconc_seri(i, id_coss)
     3871      if(id_codu>0)    sconc04(i) = sconc_seri(i, id_codu)
     3872      if(id_scdu>0)    sconc05(i) = sconc_seri(i, id_scdu)
     3873      if(id_prec>0)    flux01(i) = flux_tr(i, id_prec)
     3874      if(id_fine>0)    flux02(i) = flux_tr(i, id_fine)
     3875      if(id_coss>0)    flux03(i) = flux_tr(i, id_coss)
     3876      if(id_codu>0)    flux04(i) = flux_tr(i, id_codu)
     3877      if(id_scdu>0)    flux05(i) = flux_tr(i, id_scdu)
     3878      if(id_prec>0)    ds01(i) = his_ds(i, id_prec)
     3879      if(id_fine>0)    ds02(i) = his_ds(i, id_fine)
     3880      if(id_coss>0)    ds03(i) = his_ds(i, id_coss)
     3881      if(id_codu>0)    ds04(i) = his_ds(i, id_codu)
     3882      if(id_scdu>0)    ds05(i) = his_ds(i, id_scdu)
     3883      if(id_prec>0)    dh01(i) = his_dh(i, id_prec)
     3884      if(id_fine>0)    dh02(i) = his_dh(i, id_fine)
     3885      if(id_coss>0)    dh03(i) = his_dh(i, id_coss)
     3886      if(id_codu>0)    dh04(i) = his_dh(i, id_codu)
     3887      if(id_scdu>0)    dh05(i) = his_dh(i, id_scdu)
     3888      if(id_prec>0)    dtrconv01(i) = dtrconv(i, id_prec)
     3889      if(id_fine>0)    dtrconv02(i) = dtrconv(i, id_fine)
     3890      if(id_coss>0)    dtrconv03(i) = dtrconv(i, id_coss)
     3891      if(id_codu>0)    dtrconv04(i) = dtrconv(i, id_codu)
     3892      if(id_scdu>0)    dtrconv05(i) = dtrconv(i, id_scdu)
     3893      if(id_prec>0)    dtherm01(i) = his_th(i, id_prec)
     3894      if(id_fine>0)    dtherm02(i) = his_th(i, id_fine)
     3895      if(id_coss>0)    dtherm03(i) = his_th(i, id_coss)
     3896      if(id_codu>0)    dtherm04(i) = his_th(i, id_codu)
     3897      if(id_scdu>0)    dtherm05(i) = his_th(i, id_scdu)
     3898      if(id_prec>0)    dhkecv01(i) = his_dhkecv(i, id_prec)
     3899      if(id_fine>0)    dhkecv02(i) = his_dhkecv(i, id_fine)
     3900      if(id_coss>0)    dhkecv03(i) = his_dhkecv(i, id_coss)
     3901      if(id_codu>0)    dhkecv04(i) = his_dhkecv(i, id_codu)
     3902      if(id_scdu>0)    dhkecv05(i) = his_dhkecv(i, id_scdu)
     3903      if(id_prec>0)    d_tr_ds01(i) = his_ds(i, id_prec)
     3904      if(id_fine>0)    d_tr_ds02(i) = his_ds(i, id_fine)
     3905      if(id_coss>0)    d_tr_ds03(i) = his_ds(i, id_coss)
     3906      if(id_codu>0)    d_tr_ds04(i) = his_ds(i, id_codu)
     3907      if(id_scdu>0)    d_tr_ds05(i) = his_ds(i, id_scdu)
     3908      if(id_prec>0)    dhkelsc01(i) = his_dhkelsc(i, id_prec)
     3909      if(id_fine>0)    dhkelsc02(i) = his_dhkelsc(i, id_fine)
     3910      if(id_coss>0)    dhkelsc03(i) = his_dhkelsc(i, id_coss)
     3911      if(id_codu>0)    dhkelsc04(i) = his_dhkelsc(i, id_codu)
     3912      if(id_scdu>0)    dhkelsc05(i) = his_dhkelsc(i, id_scdu)
     3913      u10m_ss(i) = u10m_ec(i)
     3914      v10m_ss(i) = v10m_ec(i)
     3915    ENDDO
     3916    ! 3D outs
     3917    DO i = 1, klon
     3918      DO k = 1, klev
     3919        d_tr_cv01(i, k) = 0.
     3920        d_tr_cv02(i, k) = 0.
     3921        d_tr_cv03(i, k) = 0.
     3922        d_tr_cv04(i, k) = 0.
     3923        d_tr_cv05(i, k) = 0.
     3924        d_tr_trsp01(i, k) = 0.
     3925        d_tr_trsp02(i, k) = 0.
     3926        d_tr_trsp03(i, k) = 0.
     3927        d_tr_trsp04(i, k) = 0.
     3928        d_tr_trsp05(i, k) = 0.
     3929        d_tr_sscav01(i, k) = 0.
     3930        d_tr_sscav02(i, k) = 0.
     3931        d_tr_sscav03(i, k) = 0.
     3932        d_tr_sscav04(i, k) = 0.
     3933        d_tr_sscav05(i, k) = 0.
     3934        d_tr_sat01(i, k) = 0.
     3935        d_tr_sat02(i, k) = 0.
     3936        d_tr_sat03(i, k) = 0.
     3937        d_tr_sat04(i, k) = 0.
     3938        d_tr_sat05(i, k) = 0.
     3939        d_tr_uscav01(i, k) = 0.
     3940        d_tr_uscav02(i, k) = 0.
     3941        d_tr_uscav03(i, k) = 0.
     3942        d_tr_uscav04(i, k) = 0.
     3943        d_tr_uscav05(i, k) = 0.
     3944        d_tr_insc01(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     3945        d_tr_insc02(i, k) = 0.
     3946        d_tr_insc03(i, k) = 0.
     3947        d_tr_insc04(i, k) = 0.
     3948        d_tr_insc05(i, k) = 0.
     3949        d_tr_bcscav01(i, k) = 0.
     3950        d_tr_bcscav02(i, k) = 0.
     3951        d_tr_bcscav03(i, k) = 0.
     3952        d_tr_bcscav04(i, k) = 0.
     3953        d_tr_bcscav05(i, k) = 0.
     3954        d_tr_evapls01(i, k) = 0.
     3955        d_tr_evapls02(i, k) = 0.
     3956        d_tr_evapls03(i, k) = 0.
     3957        d_tr_evapls04(i, k) = 0.
     3958        d_tr_evapls05(i, k) = 0.
     3959        d_tr_ls01(i, k) = 0.
     3960        d_tr_ls02(i, k) = 0.
     3961        d_tr_ls03(i, k) = 0.
     3962        d_tr_ls04(i, k) = 0.
     3963        d_tr_ls05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     3964        d_tr_dyn01(i, k) = 0.
     3965        d_tr_dyn02(i, k) = 0.
     3966        d_tr_dyn03(i, k) = 0.
     3967        d_tr_dyn04(i, k) = 0.
     3968        d_tr_dyn05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     3969        d_tr_cl01(i, k) = 0.
     3970        d_tr_cl02(i, k) = 0.
     3971        d_tr_cl03(i, k) = 0.
     3972        d_tr_cl04(i, k) = 0.
     3973        d_tr_cl05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     3974        d_tr_th01(i, k) = 0.
     3975        d_tr_th02(i, k) = 0.
     3976        d_tr_th03(i, k) = 0.
     3977        d_tr_th04(i, k) = 0.
     3978        d_tr_th05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     3979      ENDDO
     3980    ENDDO
     3981
     3982    IF(1==0) THEN
    41103983      ! calcul in original trunk version; problem: budget not closed. Corrected in "ELSE"
    4111       DO i=1, klon
    4112         DO k=1,klev
    4113 
    4114       if(id_prec>0)        d_tr_cv01(i,k)   =d_tr_cv_o(i,k,id_prec)
    4115       if(id_fine>0)        d_tr_cv02(i,k)   =d_tr_cv_o(i,k,id_fine)
    4116       if(id_coss>0)        d_tr_cv03(i,k)   =d_tr_cv_o(i,k,id_coss)
    4117       if(id_codu>0)        d_tr_cv04(i,k)   =d_tr_cv_o(i,k,id_codu)
    4118       if(id_scdu>0)        d_tr_cv05(i,k)   =d_tr_cv_o(i,k,id_scdu)
    4119       if(id_prec>0)        d_tr_trsp01(i,k) =d_tr_trsp_o(i,k,id_prec)
    4120       if(id_fine>0)        d_tr_trsp02(i,k) =d_tr_trsp_o(i,k,id_fine)
    4121       if(id_coss>0)        d_tr_trsp03(i,k) =d_tr_trsp_o(i,k,id_coss)
    4122       if(id_codu>0)        d_tr_trsp04(i,k) =d_tr_trsp_o(i,k,id_codu)
    4123       if(id_scdu>0)        d_tr_trsp05(i,k) =d_tr_trsp_o(i,k,id_scdu)
    4124       if(id_prec>0)        d_tr_sscav01(i,k)=d_tr_sscav_o(i,k,id_prec)
    4125       if(id_fine>0)        d_tr_sscav02(i,k)=d_tr_sscav_o(i,k,id_fine)
    4126       if(id_coss>0)        d_tr_sscav03(i,k)=d_tr_sscav_o(i,k,id_coss)
    4127       if(id_codu>0)        d_tr_sscav04(i,k)=d_tr_sscav_o(i,k,id_codu)
    4128       if(id_scdu>0)        d_tr_sscav05(i,k)=d_tr_sscav_o(i,k,id_scdu)
    4129       if(id_prec>0)        d_tr_sat01(i,k)  =d_tr_sat_o(i,k,id_prec)
    4130       if(id_fine>0)        d_tr_sat02(i,k)  =d_tr_sat_o(i,k,id_fine)
    4131       if(id_coss>0)        d_tr_sat03(i,k)  =d_tr_sat_o(i,k,id_coss)
    4132       if(id_codu>0)        d_tr_sat04(i,k)  =d_tr_sat_o(i,k,id_codu)
    4133       if(id_scdu>0)        d_tr_sat05(i,k)  =d_tr_sat_o(i,k,id_scdu)
    4134       if(id_prec>0)        d_tr_uscav01(i,k)=d_tr_uscav_o(i,k,id_prec)
    4135       if(id_fine>0)        d_tr_uscav02(i,k)=d_tr_uscav_o(i,k,id_fine)
    4136       if(id_coss>0)        d_tr_uscav03(i,k)=d_tr_uscav_o(i,k,id_coss)
    4137       if(id_codu>0)        d_tr_uscav04(i,k)=d_tr_uscav_o(i,k,id_codu)
    4138       if(id_scdu>0)        d_tr_uscav05(i,k)=d_tr_uscav_o(i,k,id_scdu)
    4139       if(id_prec>0)        d_tr_insc01(i,k)=d_tr_insc_o(i,k,id_prec)
    4140       if(id_fine>0)        d_tr_insc02(i,k)=d_tr_insc_o(i,k,id_fine)
    4141       if(id_coss>0)        d_tr_insc03(i,k)=d_tr_insc_o(i,k,id_coss)
    4142       if(id_codu>0)        d_tr_insc04(i,k)=d_tr_insc_o(i,k,id_codu)
    4143       if(id_scdu>0)        d_tr_insc05(i,k)=d_tr_insc_o(i,k,id_scdu)
    4144       if(id_prec>0)        d_tr_bcscav01(i,k)=d_tr_bcscav_o(i,k,id_prec)
    4145       if(id_fine>0)        d_tr_bcscav02(i,k)=d_tr_bcscav_o(i,k,id_fine)
    4146       if(id_coss>0)        d_tr_bcscav03(i,k)=d_tr_bcscav_o(i,k,id_coss)
    4147       if(id_codu>0)        d_tr_bcscav04(i,k)=d_tr_bcscav_o(i,k,id_codu)
    4148       if(id_scdu>0)        d_tr_bcscav05(i,k)=d_tr_bcscav_o(i,k,id_scdu)
    4149       if(id_prec>0)        d_tr_evapls01(i,k)=d_tr_evapls_o(i,k,id_prec)
    4150       if(id_fine>0)        d_tr_evapls02(i,k)=d_tr_evapls_o(i,k,id_fine)
    4151       if(id_coss>0)        d_tr_evapls03(i,k)=d_tr_evapls_o(i,k,id_coss)
    4152       if(id_codu>0)        d_tr_evapls04(i,k)=d_tr_evapls_o(i,k,id_codu)
    4153       if(id_scdu>0)        d_tr_evapls05(i,k)=d_tr_evapls_o(i,k,id_scdu)
    4154         ENDDO
    4155       ENDDO
    4156       ELSE ! correction pour fermeture de bilan, par FH dans les simus de Binta pour Habib
    4157       DO i=1, klon
    4158         DO k=1,klev
    4159       if(id_prec>0)        d_tr_cv01(i,k)   =d_tr_cv(i,k,id_prec)/pdtphys
    4160       if(id_fine>0)        d_tr_cv02(i,k)   =d_tr_cv(i,k,id_fine)/pdtphys
    4161       if(id_coss>0)        d_tr_cv03(i,k)   =d_tr_cv(i,k,id_coss)/pdtphys
    4162       if(id_codu>0)        d_tr_cv04(i,k)   =d_tr_cv(i,k,id_codu)/pdtphys
    4163       if(id_scdu>0)        d_tr_cv05(i,k)   =d_tr_cv(i,k,id_scdu)/pdtphys
    4164       if(id_prec>0)        d_tr_trsp01(i,k) =d_tr_trsp(i,k,id_prec)/pdtphys
    4165       if(id_fine>0)        d_tr_trsp02(i,k) =d_tr_trsp(i,k,id_fine)/pdtphys
    4166       if(id_coss>0)        d_tr_trsp03(i,k) =d_tr_trsp(i,k,id_coss)/pdtphys
    4167       if(id_codu>0)        d_tr_trsp04(i,k) =d_tr_trsp(i,k,id_codu)/pdtphys
    4168       if(id_scdu>0)        d_tr_trsp05(i,k) =d_tr_trsp(i,k,id_scdu)/pdtphys
    4169       if(id_prec>0)        d_tr_sscav01(i,k)=d_tr_sscav(i,k,id_prec)/pdtphys
    4170       if(id_fine>0)        d_tr_sscav02(i,k)=d_tr_sscav(i,k,id_fine)/pdtphys
    4171       if(id_coss>0)        d_tr_sscav03(i,k)=d_tr_sscav(i,k,id_coss)/pdtphys
    4172       if(id_codu>0)        d_tr_sscav04(i,k)=d_tr_sscav(i,k,id_codu)/pdtphys
    4173       if(id_scdu>0)        d_tr_sscav05(i,k)=d_tr_sscav(i,k,id_scdu)/pdtphys
    4174       if(id_prec>0)        d_tr_sat01(i,k)  =d_tr_sat(i,k,id_prec)/pdtphys
    4175       if(id_fine>0)        d_tr_sat02(i,k)  =d_tr_sat(i,k,id_fine)/pdtphys
    4176       if(id_coss>0)        d_tr_sat03(i,k)  =d_tr_sat(i,k,id_coss)/pdtphys
    4177       if(id_codu>0)        d_tr_sat04(i,k)  =d_tr_sat(i,k,id_codu)/pdtphys
    4178       if(id_scdu>0)        d_tr_sat05(i,k)  =d_tr_sat(i,k,id_scdu)/pdtphys
    4179       if(id_prec>0)        d_tr_uscav01(i,k)=d_tr_uscav(i,k,id_prec)/pdtphys
    4180       if(id_fine>0)        d_tr_uscav02(i,k)=d_tr_uscav(i,k,id_fine)/pdtphys
    4181       if(id_coss>0)        d_tr_uscav03(i,k)=d_tr_uscav(i,k,id_coss)/pdtphys
    4182       if(id_codu>0)        d_tr_uscav04(i,k)=d_tr_uscav(i,k,id_codu)/pdtphys
    4183       if(id_scdu>0)        d_tr_uscav05(i,k)=d_tr_uscav(i,k,id_scdu)/pdtphys
    4184       if(id_prec>0)        d_tr_insc01(i,k)=d_tr_insc(i,k,id_prec)/pdtphys
    4185       if(id_fine>0)        d_tr_insc02(i,k)=d_tr_insc(i,k,id_fine)/pdtphys
    4186       if(id_coss>0)        d_tr_insc03(i,k)=d_tr_insc(i,k,id_coss)/pdtphys
    4187       if(id_codu>0)        d_tr_insc04(i,k)=d_tr_insc(i,k,id_codu)/pdtphys
    4188       if(id_scdu>0)        d_tr_insc05(i,k)=d_tr_insc(i,k,id_scdu)/pdtphys
    4189       if(id_prec>0)        d_tr_bcscav01(i,k)=d_tr_bcscav(i,k,id_prec)/pdtphys
    4190       if(id_fine>0)        d_tr_bcscav02(i,k)=d_tr_bcscav(i,k,id_fine)/pdtphys
    4191       if(id_coss>0)        d_tr_bcscav03(i,k)=d_tr_bcscav(i,k,id_coss)/pdtphys
    4192       if(id_codu>0)        d_tr_bcscav04(i,k)=d_tr_bcscav(i,k,id_codu)/pdtphys
    4193       if(id_scdu>0)        d_tr_bcscav05(i,k)=d_tr_bcscav(i,k,id_scdu)/pdtphys
    4194       if(id_prec>0)        d_tr_evapls01(i,k)=d_tr_evapls(i,k,id_prec)/pdtphys
    4195       if(id_fine>0)        d_tr_evapls02(i,k)=d_tr_evapls(i,k,id_fine)/pdtphys
    4196       if(id_coss>0)        d_tr_evapls03(i,k)=d_tr_evapls(i,k,id_coss)/pdtphys
    4197       if(id_codu>0)        d_tr_evapls04(i,k)=d_tr_evapls(i,k,id_codu)/pdtphys
    4198       if(id_scdu>0)        d_tr_evapls05(i,k)=d_tr_evapls(i,k,id_scdu)/pdtphys
    4199         ENDDO
    4200       ENDDO
    4201       ENDIF
    4202 
    4203       IF(1==0) THEN  ! This "if" is as in original trunk
    4204       DO i=1, klon
    4205         DO k=1,klev
    4206       if(id_prec>0)        d_tr_ls01(i,k)=d_tr_ls_o(i,k,id_prec)
    4207       if(id_fine>0)        d_tr_ls02(i,k)=d_tr_ls_o(i,k,id_fine)
    4208       if(id_coss>0)        d_tr_ls03(i,k)=d_tr_ls_o(i,k,id_coss)
    4209       if(id_codu>0)        d_tr_ls04(i,k)=d_tr_ls_o(i,k,id_codu)
    4210       if(id_scdu>0)        d_tr_ls05(i,k)=d_tr_ls_o(i,k,id_scdu)
    4211       if(id_prec>0)        d_tr_dyn01(i,k)=d_tr_dyn_o(i,k,id_prec)
    4212       if(id_fine>0)        d_tr_dyn02(i,k)=d_tr_dyn_o(i,k,id_fine)
    4213       if(id_coss>0)        d_tr_dyn03(i,k)=d_tr_dyn_o(i,k,id_coss)
    4214       if(id_codu>0)        d_tr_dyn04(i,k)=d_tr_dyn_o(i,k,id_codu)
    4215       if(id_scdu>0)        d_tr_dyn05(i,k)=d_tr_dyn_o(i,k,id_scdu)
    4216       if(id_prec>0)        d_tr_cl01(i,k)=d_tr_cl_o(i,k,id_prec)
    4217       if(id_fine>0)        d_tr_cl02(i,k)=d_tr_cl_o(i,k,id_fine)
    4218       if(id_coss>0)        d_tr_cl03(i,k)=d_tr_cl_o(i,k,id_coss)
    4219       if(id_codu>0)        d_tr_cl04(i,k)=d_tr_cl_o(i,k,id_codu)
    4220       if(id_scdu>0)        d_tr_cl05(i,k)=d_tr_cl_o(i,k,id_scdu)
    4221       if(id_prec>0)        d_tr_th01(i,k)=d_tr_th_o(i,k,id_prec)
    4222       if(id_fine>0)        d_tr_th02(i,k)=d_tr_th_o(i,k,id_fine)
    4223       if(id_coss>0)        d_tr_th03(i,k)=d_tr_th_o(i,k,id_coss)
    4224       if(id_codu>0)        d_tr_th04(i,k)=d_tr_th_o(i,k,id_codu)
    4225       if(id_scdu>0)        d_tr_th05(i,k)=d_tr_th_o(i,k,id_scdu)
    4226         ENDDO
    4227       ENDDO
    4228       ELSE
    4229       DO i=1, klon
    4230         DO k=1,klev
    4231       if(id_prec>0)        d_tr_ls01(i,k)=d_tr_ls(i,k,id_prec)/pdtphys
    4232       if(id_fine>0)        d_tr_ls02(i,k)=d_tr_ls(i,k,id_fine)/pdtphys
    4233       if(id_coss>0)        d_tr_ls03(i,k)=d_tr_ls(i,k,id_coss)/pdtphys
    4234       if(id_codu>0)        d_tr_ls04(i,k)=d_tr_ls(i,k,id_codu)/pdtphys
    4235       if(id_scdu>0)        d_tr_ls05(i,k)=d_tr_ls(i,k,id_scdu)/pdtphys
    4236       if(id_prec>0)        d_tr_dyn01(i,k)=d_tr_dyn(i,k,id_prec)/pdtphys
    4237       if(id_fine>0)        d_tr_dyn02(i,k)=d_tr_dyn(i,k,id_fine)/pdtphys
    4238       if(id_coss>0)        d_tr_dyn03(i,k)=d_tr_dyn(i,k,id_coss)/pdtphys
    4239       if(id_codu>0)        d_tr_dyn04(i,k)=d_tr_dyn(i,k,id_codu)/pdtphys
    4240       if(id_scdu>0)        d_tr_dyn05(i,k)=d_tr_dyn(i,k,id_scdu)/pdtphys
    4241       if(id_prec>0)        d_tr_cl01(i,k)=d_tr_cl(i,k,id_prec)/pdtphys
    4242       if(id_fine>0)        d_tr_cl02(i,k)=d_tr_cl(i,k,id_fine)/pdtphys
    4243       if(id_coss>0)        d_tr_cl03(i,k)=d_tr_cl(i,k,id_coss)/pdtphys
    4244       if(id_codu>0)        d_tr_cl04(i,k)=d_tr_cl(i,k,id_codu)/pdtphys
    4245       if(id_scdu>0)        d_tr_cl05(i,k)=d_tr_cl(i,k,id_scdu)/pdtphys
    4246       if(id_prec>0)        d_tr_th01(i,k)=d_tr_th(i,k,id_prec)/pdtphys
    4247       if(id_fine>0)        d_tr_th02(i,k)=d_tr_th(i,k,id_fine)/pdtphys
    4248       if(id_coss>0)        d_tr_th03(i,k)=d_tr_th(i,k,id_coss)/pdtphys
    4249       if(id_codu>0)        d_tr_th04(i,k)=d_tr_th(i,k,id_codu)/pdtphys
    4250       if(id_scdu>0)        d_tr_th05(i,k)=d_tr_th(i,k,id_scdu)/pdtphys
    4251         ENDDO
    4252       ENDDO
    4253       ENDIF
    4254      
    4255 
    4256       IF (logitime) THEN
    4257       CALL SYSTEM_CLOCK(COUNT=clock_end)
    4258 
    4259       dife=clock_end-clock_start
    4260       ti_outs=dife*MAX(0,SIGN(1,dife))   &
    4261       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    4262       tia_outs=tia_outs+REAL(ti_outs)/REAL(clock_rate)
    4263       ENDIF
    4264 
    4265       IF (logitime) THEN
    4266       CALL SYSTEM_CLOCK(COUNT=clock_end)
    4267 
    4268       dife=clock_end-clock_start_spla
    4269       ti_spla=dife*MAX(0,SIGN(1,dife)) &
    4270       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    4271 
    4272 
    4273       tia_spla=tia_spla+REAL(ti_spla)/REAL(clock_rate)
    4274   print *,'times for this timestep:timeproc,timeproc/time_pytracr_spl-'
    4275      print *,'time spla',REAL(ti_spla)/REAL(clock_rate)                &
    4276       ,REAL(ti_spla)/REAL(ti_spla)                                     
    4277      print *,'time init',REAL(ti_init)/REAL(clock_rate)                &
    4278       ,REAL(ti_init)/REAL(ti_spla)                                     
    4279      print *,'time inittype',REAL(ti_inittype)/REAL(clock_rate)        &
    4280       ,REAL(ti_inittype)/REAL(ti_spla)                                 
    4281      print *,'time inittwrite',REAL(ti_inittwrite)/REAL(clock_rate)    &
    4282       ,REAL(ti_inittwrite)/REAL(ti_spla)                               
    4283      print *,'time emis',REAL(ti_emis)/REAL(clock_rate)                &
    4284       ,REAL(ti_emis)/REAL(ti_spla)                                     
    4285      print *,'time depo ',REAL(ti_depo)/REAL(clock_rate)               &
    4286       ,REAL(ti_depo)/REAL(ti_spla)                                     
    4287      print *,'time cltr',REAL(ti_cltr)/REAL(clock_rate)                &
    4288       ,REAL(ti_cltr)/REAL(ti_spla)                                     
    4289      print *,'time ther',REAL(ti_ther)/REAL(clock_rate)                &
    4290       ,REAL(ti_ther)/REAL(ti_spla)                                     
    4291      print *,'time sedi',REAL(ti_sedi)/REAL(clock_rate)                &
    4292       ,REAL(ti_sedi)/REAL(ti_spla)                                     
    4293      print *,'time gas to part',REAL(ti_gasp)/REAL(clock_rate)         &
    4294       ,REAL(ti_gasp)/REAL(ti_spla)                                     
    4295      print *,'time AP wet',REAL(ti_wetap)/REAL(clock_rate)             &
    4296       ,REAL(ti_wetap)/REAL(ti_spla)                                     
    4297      print *,'time convective',REAL(ti_cvltr)/REAL(clock_rate)         &
    4298       ,REAL(ti_cvltr)/REAL(ti_spla)                                     
    4299      print *,'time NP lsc scav',REAL(ti_lscs)/REAL(clock_rate)         &
    4300       ,REAL(ti_lscs)/REAL(ti_spla)                                     
    4301      print *,'time opt,brdn,etc',REAL(ti_brop)/REAL(clock_rate)        &
    4302       ,REAL(ti_brop)/REAL(ti_spla)                                     
    4303      print *,'time outputs',REAL(ti_outs)/REAL(clock_rate)             &
    4304       ,REAL(ti_outs)/REAL(ti_spla)
    4305 
    4306 
    4307   print *,'--time accumulated: time proc, time proc/time phytracr_spl--'
    4308       print *,'time spla',tia_spla
    4309       print *,'time init',tia_init,tia_init/tia_spla
    4310       print *,'time inittype',tia_inittype,tia_inittype/tia_spla
    4311       print *,'time inittwrite',tia_inittwrite,tia_inittwrite/tia_spla
    4312       print *,'time emis',tia_emis,tia_emis/tia_spla
    4313       print *,'time depo',tia_depo,tia_depo/tia_spla
    4314       print *,'time cltr',tia_cltr,tia_cltr/tia_spla
    4315       print *,'time ther',tia_ther,tia_ther/tia_spla
    4316       print *,'time sedi',tia_sedi,tia_sedi/tia_spla
    4317       print *,'time gas to part',tia_gasp,tia_gasp/tia_spla
    4318       print *,'time AP wet',tia_wetap,tia_wetap/tia_spla
    4319       print *,'time convective',tia_cvltr,tia_cvltr/tia_spla
    4320       print *,'time NP lsc scav',tia_lscs,tia_lscs/tia_spla
    4321       print *,'time opt,brdn,etc',tia_brop,tia_brop/tia_spla
    4322       print *,'time outputs',tia_outs,tia_outs/tia_spla
    4323 
    4324 
    4325 
    4326       dife=clock_end_outphytracr-clock_start_outphytracr
    4327       ti_nophytracr=dife*MAX(0,SIGN(1,dife))  &
    4328       +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
    4329       tia_nophytracr=tia_nophytracr+REAL(ti_nophytracr)/REAL(clock_rate)
    4330       print *,'Time outside phytracr; Time accum outside phytracr'
    4331       print*,REAL(ti_nophytracr)/REAL(clock_rate),tia_nophytracr
    4332 
    4333       clock_start_outphytracr=clock_end
    4334 
    4335       ENDIF     
    4336       print *,'END PHYTRACR_SPL '
    4337   print *,'lmt_so2ff_l FIN' , MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
    4338 
    4339 !      CALL abort_gcm('TEST1', 'OK1', 1)
    4340 
    4341       RETURN
    4342       END SUBROUTINE phytracr_spl
    4343  
    4344       SUBROUTINE readregionsdims2_spl(nbreg,fileregions)
    4345 
    4346       USE mod_grid_phy_lmdz
    4347       USE mod_phys_lmdz_para
    4348 
    4349       IMPLICIT NONE
    4350       CHARACTER*800 fileregions
    4351       CHARACTER*800 auxstr
    4352       INTEGER nbreg
    4353  
    4354       IF (is_mpi_root .AND. is_omp_root) THEN
    4355 
    4356       OPEN (UNIT=1,FILE=trim(adjustl(fileregions)))
    4357       READ(1,'(a)') auxstr
    4358       READ(1,'(i10)') nbreg
    4359       CLOSE(UNIT=1)
    4360       ENDIF
    4361       CALL bcast(nbreg)
    4362 
    4363       END SUBROUTINE readregionsdims2_spl
    4364 
    4365       SUBROUTINE readregionsdims_spl(nbreg_ind,fileregionsdimsind,   &
    4366                                     nbreg_dust,fileregionsdimsdust,  &
    4367                                     nbreg_bb,fileregionsdimsbb)     
    4368       USE mod_grid_phy_lmdz
    4369       USE mod_phys_lmdz_para
    4370 
    4371       IMPLICIT NONE
    4372       CHARACTER*800 fileregionsdimsind
    4373       CHARACTER*800 fileregionsdimsdust
    4374       CHARACTER*800 fileregionsdimsbb
    4375       CHARACTER*800 auxstr
    4376       INTEGER nbreg_ind,nbreg_dust,nbreg_bb
    4377  
    4378       IF (is_mpi_root .AND. is_omp_root) THEN
    4379 
    4380       OPEN (UNIT=1,FILE=trim(adjustl(fileregionsdimsind)))
    4381       READ(1,'(a)') auxstr
    4382       READ(1,'(i10)') nbreg_ind
    4383       CLOSE(UNIT=1)
    4384 
    4385       OPEN (UNIT=1,FILE=trim(adjustl(fileregionsdimsdust)))
    4386       READ(1,'(a)') auxstr
    4387       READ(1,'(i10)') nbreg_dust
    4388       CLOSE(UNIT=1)
    4389 
    4390       OPEN (UNIT=1,FILE=trim(adjustl(fileregionsdimsbb)))
    4391       READ(1,'(a)') auxstr
    4392       READ(1,'(i10)') nbreg_bb
    4393       CLOSE(UNIT=1)
    4394      
    4395 
    4396       ENDIF
    4397       CALL bcast(nbreg_ind)
    4398       CALL bcast(nbreg_dust)
    4399       CALL bcast(nbreg_bb)
    4400 
    4401       END SUBROUTINE readregionsdims_spl
    4402 
    4403       SUBROUTINE readregions_spl(iregion,filenameregion)
    4404       USE dimphy
    4405       USE mod_grid_phy_lmdz
    4406       USE mod_phys_lmdz_para
    4407 
    4408       IMPLICIT NONE
    4409       CHARACTER*(*) filenameregion
    4410       INTEGER iregion(klon)
    4411       INTEGER iregion_glo(klon_glo)
    4412       INTEGER k
    4413      
    4414       IF (is_mpi_root .AND. is_omp_root) THEN
    4415 
    4416       print *,trim(adjustl(filenameregion))
    4417       OPEN(1,file=trim(adjustl(filenameregion)))
    4418       DO k=1,klon_glo
    4419       READ(1,'(i10)') iregion_glo(k)
    4420       ENDDO
    4421       CLOSE(UNIT=1)
    4422       ENDIF
    4423       CALL scatter(iregion_glo,iregion)
    4424 
    4425       END SUBROUTINE readregions_spl
    4426 
    4427 !! AS: SUBROUTINE readscaleparams_spl pas appellee
    4428       SUBROUTINE readscaleparams_spl(scale_param, nbreg, &
    4429                                              filescaleparams)
    4430       USE mod_grid_phy_lmdz
    4431       USE mod_phys_lmdz_para
    4432       IMPLICIT NONE
    4433 
    4434       CHARACTER*800 filescaleparams
    4435       INTEGER nbreg
    4436       REAL scale_param(nbreg)
    4437       INTEGER k
    4438 
    4439       IF (is_mpi_root .AND. is_omp_root) THEN
    4440       OPEN(1,file=trim(adjustl(filescaleparams)),form='unformatted')
    4441       do k=1,nbreg
     3984      DO i = 1, klon
     3985        DO k = 1, klev
     3986
     3987          if(id_prec>0)        d_tr_cv01(i, k) = d_tr_cv_o(i, k, id_prec)
     3988          if(id_fine>0)        d_tr_cv02(i, k) = d_tr_cv_o(i, k, id_fine)
     3989          if(id_coss>0)        d_tr_cv03(i, k) = d_tr_cv_o(i, k, id_coss)
     3990          if(id_codu>0)        d_tr_cv04(i, k) = d_tr_cv_o(i, k, id_codu)
     3991          if(id_scdu>0)        d_tr_cv05(i, k) = d_tr_cv_o(i, k, id_scdu)
     3992          if(id_prec>0)        d_tr_trsp01(i, k) = d_tr_trsp_o(i, k, id_prec)
     3993          if(id_fine>0)        d_tr_trsp02(i, k) = d_tr_trsp_o(i, k, id_fine)
     3994          if(id_coss>0)        d_tr_trsp03(i, k) = d_tr_trsp_o(i, k, id_coss)
     3995          if(id_codu>0)        d_tr_trsp04(i, k) = d_tr_trsp_o(i, k, id_codu)
     3996          if(id_scdu>0)        d_tr_trsp05(i, k) = d_tr_trsp_o(i, k, id_scdu)
     3997          if(id_prec>0)        d_tr_sscav01(i, k) = d_tr_sscav_o(i, k, id_prec)
     3998          if(id_fine>0)        d_tr_sscav02(i, k) = d_tr_sscav_o(i, k, id_fine)
     3999          if(id_coss>0)        d_tr_sscav03(i, k) = d_tr_sscav_o(i, k, id_coss)
     4000          if(id_codu>0)        d_tr_sscav04(i, k) = d_tr_sscav_o(i, k, id_codu)
     4001          if(id_scdu>0)        d_tr_sscav05(i, k) = d_tr_sscav_o(i, k, id_scdu)
     4002          if(id_prec>0)        d_tr_sat01(i, k) = d_tr_sat_o(i, k, id_prec)
     4003          if(id_fine>0)        d_tr_sat02(i, k) = d_tr_sat_o(i, k, id_fine)
     4004          if(id_coss>0)        d_tr_sat03(i, k) = d_tr_sat_o(i, k, id_coss)
     4005          if(id_codu>0)        d_tr_sat04(i, k) = d_tr_sat_o(i, k, id_codu)
     4006          if(id_scdu>0)        d_tr_sat05(i, k) = d_tr_sat_o(i, k, id_scdu)
     4007          if(id_prec>0)        d_tr_uscav01(i, k) = d_tr_uscav_o(i, k, id_prec)
     4008          if(id_fine>0)        d_tr_uscav02(i, k) = d_tr_uscav_o(i, k, id_fine)
     4009          if(id_coss>0)        d_tr_uscav03(i, k) = d_tr_uscav_o(i, k, id_coss)
     4010          if(id_codu>0)        d_tr_uscav04(i, k) = d_tr_uscav_o(i, k, id_codu)
     4011          if(id_scdu>0)        d_tr_uscav05(i, k) = d_tr_uscav_o(i, k, id_scdu)
     4012          if(id_prec>0)        d_tr_insc01(i, k) = d_tr_insc_o(i, k, id_prec)
     4013          if(id_fine>0)        d_tr_insc02(i, k) = d_tr_insc_o(i, k, id_fine)
     4014          if(id_coss>0)        d_tr_insc03(i, k) = d_tr_insc_o(i, k, id_coss)
     4015          if(id_codu>0)        d_tr_insc04(i, k) = d_tr_insc_o(i, k, id_codu)
     4016          if(id_scdu>0)        d_tr_insc05(i, k) = d_tr_insc_o(i, k, id_scdu)
     4017          if(id_prec>0)        d_tr_bcscav01(i, k) = d_tr_bcscav_o(i, k, id_prec)
     4018          if(id_fine>0)        d_tr_bcscav02(i, k) = d_tr_bcscav_o(i, k, id_fine)
     4019          if(id_coss>0)        d_tr_bcscav03(i, k) = d_tr_bcscav_o(i, k, id_coss)
     4020          if(id_codu>0)        d_tr_bcscav04(i, k) = d_tr_bcscav_o(i, k, id_codu)
     4021          if(id_scdu>0)        d_tr_bcscav05(i, k) = d_tr_bcscav_o(i, k, id_scdu)
     4022          if(id_prec>0)        d_tr_evapls01(i, k) = d_tr_evapls_o(i, k, id_prec)
     4023          if(id_fine>0)        d_tr_evapls02(i, k) = d_tr_evapls_o(i, k, id_fine)
     4024          if(id_coss>0)        d_tr_evapls03(i, k) = d_tr_evapls_o(i, k, id_coss)
     4025          if(id_codu>0)        d_tr_evapls04(i, k) = d_tr_evapls_o(i, k, id_codu)
     4026          if(id_scdu>0)        d_tr_evapls05(i, k) = d_tr_evapls_o(i, k, id_scdu)
     4027        ENDDO
     4028      ENDDO
     4029    ELSE ! correction pour fermeture de bilan, par FH dans les simus de Binta pour Habib
     4030      DO i = 1, klon
     4031        DO k = 1, klev
     4032          if(id_prec>0)        d_tr_cv01(i, k) = d_tr_cv(i, k, id_prec) / pdtphys
     4033          if(id_fine>0)        d_tr_cv02(i, k) = d_tr_cv(i, k, id_fine) / pdtphys
     4034          if(id_coss>0)        d_tr_cv03(i, k) = d_tr_cv(i, k, id_coss) / pdtphys
     4035          if(id_codu>0)        d_tr_cv04(i, k) = d_tr_cv(i, k, id_codu) / pdtphys
     4036          if(id_scdu>0)        d_tr_cv05(i, k) = d_tr_cv(i, k, id_scdu) / pdtphys
     4037          if(id_prec>0)        d_tr_trsp01(i, k) = d_tr_trsp(i, k, id_prec) / pdtphys
     4038          if(id_fine>0)        d_tr_trsp02(i, k) = d_tr_trsp(i, k, id_fine) / pdtphys
     4039          if(id_coss>0)        d_tr_trsp03(i, k) = d_tr_trsp(i, k, id_coss) / pdtphys
     4040          if(id_codu>0)        d_tr_trsp04(i, k) = d_tr_trsp(i, k, id_codu) / pdtphys
     4041          if(id_scdu>0)        d_tr_trsp05(i, k) = d_tr_trsp(i, k, id_scdu) / pdtphys
     4042          if(id_prec>0)        d_tr_sscav01(i, k) = d_tr_sscav(i, k, id_prec) / pdtphys
     4043          if(id_fine>0)        d_tr_sscav02(i, k) = d_tr_sscav(i, k, id_fine) / pdtphys
     4044          if(id_coss>0)        d_tr_sscav03(i, k) = d_tr_sscav(i, k, id_coss) / pdtphys
     4045          if(id_codu>0)        d_tr_sscav04(i, k) = d_tr_sscav(i, k, id_codu) / pdtphys
     4046          if(id_scdu>0)        d_tr_sscav05(i, k) = d_tr_sscav(i, k, id_scdu) / pdtphys
     4047          if(id_prec>0)        d_tr_sat01(i, k) = d_tr_sat(i, k, id_prec) / pdtphys
     4048          if(id_fine>0)        d_tr_sat02(i, k) = d_tr_sat(i, k, id_fine) / pdtphys
     4049          if(id_coss>0)        d_tr_sat03(i, k) = d_tr_sat(i, k, id_coss) / pdtphys
     4050          if(id_codu>0)        d_tr_sat04(i, k) = d_tr_sat(i, k, id_codu) / pdtphys
     4051          if(id_scdu>0)        d_tr_sat05(i, k) = d_tr_sat(i, k, id_scdu) / pdtphys
     4052          if(id_prec>0)        d_tr_uscav01(i, k) = d_tr_uscav(i, k, id_prec) / pdtphys
     4053          if(id_fine>0)        d_tr_uscav02(i, k) = d_tr_uscav(i, k, id_fine) / pdtphys
     4054          if(id_coss>0)        d_tr_uscav03(i, k) = d_tr_uscav(i, k, id_coss) / pdtphys
     4055          if(id_codu>0)        d_tr_uscav04(i, k) = d_tr_uscav(i, k, id_codu) / pdtphys
     4056          if(id_scdu>0)        d_tr_uscav05(i, k) = d_tr_uscav(i, k, id_scdu) / pdtphys
     4057          if(id_prec>0)        d_tr_insc01(i, k) = d_tr_insc(i, k, id_prec) / pdtphys
     4058          if(id_fine>0)        d_tr_insc02(i, k) = d_tr_insc(i, k, id_fine) / pdtphys
     4059          if(id_coss>0)        d_tr_insc03(i, k) = d_tr_insc(i, k, id_coss) / pdtphys
     4060          if(id_codu>0)        d_tr_insc04(i, k) = d_tr_insc(i, k, id_codu) / pdtphys
     4061          if(id_scdu>0)        d_tr_insc05(i, k) = d_tr_insc(i, k, id_scdu) / pdtphys
     4062          if(id_prec>0)        d_tr_bcscav01(i, k) = d_tr_bcscav(i, k, id_prec) / pdtphys
     4063          if(id_fine>0)        d_tr_bcscav02(i, k) = d_tr_bcscav(i, k, id_fine) / pdtphys
     4064          if(id_coss>0)        d_tr_bcscav03(i, k) = d_tr_bcscav(i, k, id_coss) / pdtphys
     4065          if(id_codu>0)        d_tr_bcscav04(i, k) = d_tr_bcscav(i, k, id_codu) / pdtphys
     4066          if(id_scdu>0)        d_tr_bcscav05(i, k) = d_tr_bcscav(i, k, id_scdu) / pdtphys
     4067          if(id_prec>0)        d_tr_evapls01(i, k) = d_tr_evapls(i, k, id_prec) / pdtphys
     4068          if(id_fine>0)        d_tr_evapls02(i, k) = d_tr_evapls(i, k, id_fine) / pdtphys
     4069          if(id_coss>0)        d_tr_evapls03(i, k) = d_tr_evapls(i, k, id_coss) / pdtphys
     4070          if(id_codu>0)        d_tr_evapls04(i, k) = d_tr_evapls(i, k, id_codu) / pdtphys
     4071          if(id_scdu>0)        d_tr_evapls05(i, k) = d_tr_evapls(i, k, id_scdu) / pdtphys
     4072        ENDDO
     4073      ENDDO
     4074    ENDIF
     4075
     4076    IF(1==0) THEN  ! This "if" is as in original trunk
     4077      DO i = 1, klon
     4078        DO k = 1, klev
     4079          if(id_prec>0)        d_tr_ls01(i, k) = d_tr_ls_o(i, k, id_prec)
     4080          if(id_fine>0)        d_tr_ls02(i, k) = d_tr_ls_o(i, k, id_fine)
     4081          if(id_coss>0)        d_tr_ls03(i, k) = d_tr_ls_o(i, k, id_coss)
     4082          if(id_codu>0)        d_tr_ls04(i, k) = d_tr_ls_o(i, k, id_codu)
     4083          if(id_scdu>0)        d_tr_ls05(i, k) = d_tr_ls_o(i, k, id_scdu)
     4084          if(id_prec>0)        d_tr_dyn01(i, k) = d_tr_dyn_o(i, k, id_prec)
     4085          if(id_fine>0)        d_tr_dyn02(i, k) = d_tr_dyn_o(i, k, id_fine)
     4086          if(id_coss>0)        d_tr_dyn03(i, k) = d_tr_dyn_o(i, k, id_coss)
     4087          if(id_codu>0)        d_tr_dyn04(i, k) = d_tr_dyn_o(i, k, id_codu)
     4088          if(id_scdu>0)        d_tr_dyn05(i, k) = d_tr_dyn_o(i, k, id_scdu)
     4089          if(id_prec>0)        d_tr_cl01(i, k) = d_tr_cl_o(i, k, id_prec)
     4090          if(id_fine>0)        d_tr_cl02(i, k) = d_tr_cl_o(i, k, id_fine)
     4091          if(id_coss>0)        d_tr_cl03(i, k) = d_tr_cl_o(i, k, id_coss)
     4092          if(id_codu>0)        d_tr_cl04(i, k) = d_tr_cl_o(i, k, id_codu)
     4093          if(id_scdu>0)        d_tr_cl05(i, k) = d_tr_cl_o(i, k, id_scdu)
     4094          if(id_prec>0)        d_tr_th01(i, k) = d_tr_th_o(i, k, id_prec)
     4095          if(id_fine>0)        d_tr_th02(i, k) = d_tr_th_o(i, k, id_fine)
     4096          if(id_coss>0)        d_tr_th03(i, k) = d_tr_th_o(i, k, id_coss)
     4097          if(id_codu>0)        d_tr_th04(i, k) = d_tr_th_o(i, k, id_codu)
     4098          if(id_scdu>0)        d_tr_th05(i, k) = d_tr_th_o(i, k, id_scdu)
     4099        ENDDO
     4100      ENDDO
     4101    ELSE
     4102      DO i = 1, klon
     4103        DO k = 1, klev
     4104          if(id_prec>0)        d_tr_ls01(i, k) = d_tr_ls(i, k, id_prec) / pdtphys
     4105          if(id_fine>0)        d_tr_ls02(i, k) = d_tr_ls(i, k, id_fine) / pdtphys
     4106          if(id_coss>0)        d_tr_ls03(i, k) = d_tr_ls(i, k, id_coss) / pdtphys
     4107          if(id_codu>0)        d_tr_ls04(i, k) = d_tr_ls(i, k, id_codu) / pdtphys
     4108          if(id_scdu>0)        d_tr_ls05(i, k) = d_tr_ls(i, k, id_scdu) / pdtphys
     4109          if(id_prec>0)        d_tr_dyn01(i, k) = d_tr_dyn(i, k, id_prec) / pdtphys
     4110          if(id_fine>0)        d_tr_dyn02(i, k) = d_tr_dyn(i, k, id_fine) / pdtphys
     4111          if(id_coss>0)        d_tr_dyn03(i, k) = d_tr_dyn(i, k, id_coss) / pdtphys
     4112          if(id_codu>0)        d_tr_dyn04(i, k) = d_tr_dyn(i, k, id_codu) / pdtphys
     4113          if(id_scdu>0)        d_tr_dyn05(i, k) = d_tr_dyn(i, k, id_scdu) / pdtphys
     4114          if(id_prec>0)        d_tr_cl01(i, k) = d_tr_cl(i, k, id_prec) / pdtphys
     4115          if(id_fine>0)        d_tr_cl02(i, k) = d_tr_cl(i, k, id_fine) / pdtphys
     4116          if(id_coss>0)        d_tr_cl03(i, k) = d_tr_cl(i, k, id_coss) / pdtphys
     4117          if(id_codu>0)        d_tr_cl04(i, k) = d_tr_cl(i, k, id_codu) / pdtphys
     4118          if(id_scdu>0)        d_tr_cl05(i, k) = d_tr_cl(i, k, id_scdu) / pdtphys
     4119          if(id_prec>0)        d_tr_th01(i, k) = d_tr_th(i, k, id_prec) / pdtphys
     4120          if(id_fine>0)        d_tr_th02(i, k) = d_tr_th(i, k, id_fine) / pdtphys
     4121          if(id_coss>0)        d_tr_th03(i, k) = d_tr_th(i, k, id_coss) / pdtphys
     4122          if(id_codu>0)        d_tr_th04(i, k) = d_tr_th(i, k, id_codu) / pdtphys
     4123          if(id_scdu>0)        d_tr_th05(i, k) = d_tr_th(i, k, id_scdu) / pdtphys
     4124        ENDDO
     4125      ENDDO
     4126    ENDIF
     4127
     4128    IF (logitime) THEN
     4129      CALL SYSTEM_CLOCK(COUNT = clock_end)
     4130
     4131      dife = clock_end - clock_start
     4132      ti_outs = dife * MAX(0, SIGN(1, dife))   &
     4133              + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     4134      tia_outs = tia_outs + REAL(ti_outs) / REAL(clock_rate)
     4135    ENDIF
     4136
     4137    IF (logitime) THEN
     4138      CALL SYSTEM_CLOCK(COUNT = clock_end)
     4139
     4140      dife = clock_end - clock_start_spla
     4141      ti_spla = dife * MAX(0, SIGN(1, dife)) &
     4142              + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     4143
     4144      tia_spla = tia_spla + REAL(ti_spla) / REAL(clock_rate)
     4145      print *, 'times for this timestep:timeproc,timeproc/time_pytracr_spl-'
     4146      print *, 'time spla', REAL(ti_spla) / REAL(clock_rate)                &
     4147              , REAL(ti_spla) / REAL(ti_spla)
     4148      print *, 'time init', REAL(ti_init) / REAL(clock_rate)                &
     4149              , REAL(ti_init) / REAL(ti_spla)
     4150      print *, 'time inittype', REAL(ti_inittype) / REAL(clock_rate)        &
     4151              , REAL(ti_inittype) / REAL(ti_spla)
     4152      print *, 'time inittwrite', REAL(ti_inittwrite) / REAL(clock_rate)    &
     4153              , REAL(ti_inittwrite) / REAL(ti_spla)
     4154      print *, 'time emis', REAL(ti_emis) / REAL(clock_rate)                &
     4155              , REAL(ti_emis) / REAL(ti_spla)
     4156      print *, 'time depo ', REAL(ti_depo) / REAL(clock_rate)               &
     4157              , REAL(ti_depo) / REAL(ti_spla)
     4158      print *, 'time cltr', REAL(ti_cltr) / REAL(clock_rate)                &
     4159              , REAL(ti_cltr) / REAL(ti_spla)
     4160      print *, 'time ther', REAL(ti_ther) / REAL(clock_rate)                &
     4161              , REAL(ti_ther) / REAL(ti_spla)
     4162      print *, 'time sedi', REAL(ti_sedi) / REAL(clock_rate)                &
     4163              , REAL(ti_sedi) / REAL(ti_spla)
     4164      print *, 'time gas to part', REAL(ti_gasp) / REAL(clock_rate)         &
     4165              , REAL(ti_gasp) / REAL(ti_spla)
     4166      print *, 'time AP wet', REAL(ti_wetap) / REAL(clock_rate)             &
     4167              , REAL(ti_wetap) / REAL(ti_spla)
     4168      print *, 'time convective', REAL(ti_cvltr) / REAL(clock_rate)         &
     4169              , REAL(ti_cvltr) / REAL(ti_spla)
     4170      print *, 'time NP lsc scav', REAL(ti_lscs) / REAL(clock_rate)         &
     4171              , REAL(ti_lscs) / REAL(ti_spla)
     4172      print *, 'time opt,brdn,etc', REAL(ti_brop) / REAL(clock_rate)        &
     4173              , REAL(ti_brop) / REAL(ti_spla)
     4174      print *, 'time outputs', REAL(ti_outs) / REAL(clock_rate)             &
     4175              , REAL(ti_outs) / REAL(ti_spla)
     4176
     4177      print *, '--time accumulated: time proc, time proc/time phytracr_spl--'
     4178      print *, 'time spla', tia_spla
     4179      print *, 'time init', tia_init, tia_init / tia_spla
     4180      print *, 'time inittype', tia_inittype, tia_inittype / tia_spla
     4181      print *, 'time inittwrite', tia_inittwrite, tia_inittwrite / tia_spla
     4182      print *, 'time emis', tia_emis, tia_emis / tia_spla
     4183      print *, 'time depo', tia_depo, tia_depo / tia_spla
     4184      print *, 'time cltr', tia_cltr, tia_cltr / tia_spla
     4185      print *, 'time ther', tia_ther, tia_ther / tia_spla
     4186      print *, 'time sedi', tia_sedi, tia_sedi / tia_spla
     4187      print *, 'time gas to part', tia_gasp, tia_gasp / tia_spla
     4188      print *, 'time AP wet', tia_wetap, tia_wetap / tia_spla
     4189      print *, 'time convective', tia_cvltr, tia_cvltr / tia_spla
     4190      print *, 'time NP lsc scav', tia_lscs, tia_lscs / tia_spla
     4191      print *, 'time opt,brdn,etc', tia_brop, tia_brop / tia_spla
     4192      print *, 'time outputs', tia_outs, tia_outs / tia_spla
     4193
     4194      dife = clock_end_outphytracr - clock_start_outphytracr
     4195      ti_nophytracr = dife * MAX(0, SIGN(1, dife))  &
     4196              + (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
     4197      tia_nophytracr = tia_nophytracr + REAL(ti_nophytracr) / REAL(clock_rate)
     4198      print *, 'Time outside phytracr; Time accum outside phytracr'
     4199      print*, REAL(ti_nophytracr) / REAL(clock_rate), tia_nophytracr
     4200
     4201      clock_start_outphytracr = clock_end
     4202
     4203    ENDIF
     4204    print *, 'END PHYTRACR_SPL '
     4205    print *, 'lmt_so2ff_l FIN', MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
     4206
     4207    !      CALL abort_gcm('TEST1', 'OK1', 1)
     4208
     4209    RETURN
     4210  END SUBROUTINE phytracr_spl
     4211
     4212  SUBROUTINE readregionsdims2_spl(nbreg, fileregions)
     4213
     4214    USE mod_grid_phy_lmdz
     4215    USE mod_phys_lmdz_para
     4216
     4217    IMPLICIT NONE
     4218    CHARACTER*800 fileregions
     4219    CHARACTER*800 auxstr
     4220    INTEGER nbreg
     4221
     4222    IF (is_mpi_root .AND. is_omp_root) THEN
     4223
     4224      OPEN (UNIT = 1, FILE = trim(adjustl(fileregions)))
     4225      READ(1, '(a)') auxstr
     4226      READ(1, '(i10)') nbreg
     4227      CLOSE(UNIT = 1)
     4228    ENDIF
     4229    CALL bcast(nbreg)
     4230
     4231  END SUBROUTINE readregionsdims2_spl
     4232
     4233  SUBROUTINE readregionsdims_spl(nbreg_ind, fileregionsdimsind, &
     4234          nbreg_dust, fileregionsdimsdust, &
     4235          nbreg_bb, fileregionsdimsbb)
     4236    USE mod_grid_phy_lmdz
     4237    USE mod_phys_lmdz_para
     4238
     4239    IMPLICIT NONE
     4240    CHARACTER*800 fileregionsdimsind
     4241    CHARACTER*800 fileregionsdimsdust
     4242    CHARACTER*800 fileregionsdimsbb
     4243    CHARACTER*800 auxstr
     4244    INTEGER nbreg_ind, nbreg_dust, nbreg_bb
     4245
     4246    IF (is_mpi_root .AND. is_omp_root) THEN
     4247
     4248      OPEN (UNIT = 1, FILE = trim(adjustl(fileregionsdimsind)))
     4249      READ(1, '(a)') auxstr
     4250      READ(1, '(i10)') nbreg_ind
     4251      CLOSE(UNIT = 1)
     4252
     4253      OPEN (UNIT = 1, FILE = trim(adjustl(fileregionsdimsdust)))
     4254      READ(1, '(a)') auxstr
     4255      READ(1, '(i10)') nbreg_dust
     4256      CLOSE(UNIT = 1)
     4257
     4258      OPEN (UNIT = 1, FILE = trim(adjustl(fileregionsdimsbb)))
     4259      READ(1, '(a)') auxstr
     4260      READ(1, '(i10)') nbreg_bb
     4261      CLOSE(UNIT = 1)
     4262
     4263    ENDIF
     4264    CALL bcast(nbreg_ind)
     4265    CALL bcast(nbreg_dust)
     4266    CALL bcast(nbreg_bb)
     4267
     4268  END SUBROUTINE readregionsdims_spl
     4269
     4270  SUBROUTINE readregions_spl(iregion, filenameregion)
     4271    USE dimphy
     4272    USE mod_grid_phy_lmdz
     4273    USE mod_phys_lmdz_para
     4274
     4275    IMPLICIT NONE
     4276    CHARACTER*(*) filenameregion
     4277    INTEGER iregion(klon)
     4278    INTEGER iregion_glo(klon_glo)
     4279    INTEGER k
     4280
     4281    IF (is_mpi_root .AND. is_omp_root) THEN
     4282
     4283      print *, trim(adjustl(filenameregion))
     4284      OPEN(1, file = trim(adjustl(filenameregion)))
     4285      DO k = 1, klon_glo
     4286        READ(1, '(i10)') iregion_glo(k)
     4287      ENDDO
     4288      CLOSE(UNIT = 1)
     4289    ENDIF
     4290    CALL scatter(iregion_glo, iregion)
     4291
     4292  END SUBROUTINE readregions_spl
     4293
     4294  !! AS: SUBROUTINE readscaleparams_spl pas appellee
     4295  SUBROUTINE readscaleparams_spl(scale_param, nbreg, &
     4296          filescaleparams)
     4297    USE mod_grid_phy_lmdz
     4298    USE mod_phys_lmdz_para
     4299    IMPLICIT NONE
     4300
     4301    CHARACTER*800 filescaleparams
     4302    INTEGER nbreg
     4303    REAL scale_param(nbreg)
     4304    INTEGER k
     4305
     4306    IF (is_mpi_root .AND. is_omp_root) THEN
     4307      OPEN(1, file = trim(adjustl(filescaleparams)), form = 'unformatted')
     4308      do k = 1, nbreg
    44424309        read(1)  scale_param(k)
    44434310      enddo
    4444       CLOSE(1) 
    4445       ENDIF
    4446       CALL bcast(scale_param)
    4447 !      print *,'holaaaaaaaaaaaa'
    4448 !      print *,scale_param
    4449 
    4450       END SUBROUTINE readscaleparams_spl
    4451 
    4452       SUBROUTINE readscaleparamsnc_spl(scale_param_ind,                 &
    4453         nbreg_ind, paramname_ind,                                       &
    4454         scale_param_ff, nbreg_ff,paramname_ff,                          &
    4455         scale_param_bb, nbreg_bb,paramname_bb,                          &
    4456         scale_param_dustacc, nbreg_dustacc,paramname_dustacc,           &
    4457         scale_param_dustcoa, nbreg_dustcoa,paramname_dustcoa,           &
    4458         scale_param_dustsco, nbreg_dustsco,paramname_dustsco,           &
    4459         param_wstarBLperregion, nbreg_wstardustBL, paramname_wstarBL,     &
    4460         param_wstarWAKEperregion, nbreg_wstardustWAKE, paramname_wstarWAKE, &
    4461         scale_param_ssacc  ,  paramname_ssacc,             &
    4462         scale_param_sscoa  ,  paramname_sscoa,             &
    4463            filescaleparams,julien,jH_phys, pdtphys,debutphy)
    4464 !      SUBROUTINE readscaleparamsnc_spl(scale_param, nbreg, &
    4465 !                                        filescaleparams,paramname,&
    4466 !                                        julien,jH_phys, pdtphys,debutphy)
    4467       USE mod_grid_phy_lmdz
    4468       USE mod_phys_lmdz_para
    4469       IMPLICIT NONE
    4470 
    4471       CHARACTER*800 filescaleparams
    4472       CHARACTER*100 paramname_ind,paramname_ff,paramname_bb         
    4473       CHARACTER*100 paramname_dustacc, paramname_dustcoa
    4474       CHARACTER*100 paramname_dustsco
    4475       CHARACTER*100 paramname_ssacc
    4476       CHARACTER*100 paramname_sscoa
    4477       CHARACTER*100 paramname_wstarBL
    4478       CHARACTER*100 paramname_wstarWAKE
    4479      
    4480       INTEGER nbreg,iday
    4481       INTEGER nbreg_ind, nbreg_ff, nbreg_bb , nbreg_dustacc
    4482       INTEGER nbreg_dustcoa , nbreg_dustsco, nbreg_wstardustBL
    4483       INTEGER  nbreg_wstardustWAKE
    4484       INTEGER,PARAMETER ::  nbreg_ssacc=1
    4485       INTEGER,PARAMETER :: nbreg_sscoa=1
    4486       REAL,PARAMETER :: sca_resol = 24. ! resolution of scalig params in hours
    4487       REAL scale_param_ind(nbreg_ind)
    4488       REAL scale_param_bb(nbreg_bb)
    4489       REAL scale_param_ff(nbreg_ff)
    4490       REAL scale_param_dustacc(nbreg_dustacc)
    4491       REAL scale_param_dustcoa(nbreg_dustcoa)
    4492       REAL scale_param_dustsco(nbreg_dustsco)
    4493       REAL param_wstarBLperregion(nbreg_wstardustBL)
    4494       REAL param_wstarWAKEperregion(nbreg_wstardustWAKE)
    4495       REAL scale_param_ssacc
    4496       REAL scale_param_ssacc_tmp(nbreg_ssacc)
    4497       REAL scale_param_sscoa
    4498       REAL scale_param_sscoa_tmp(nbreg_sscoa)
    4499 
    4500       INTEGER k,step_sca,test_sca
    4501       REAL :: jH_phys,  pdtphys
    4502       REAL,SAVE :: jH_sca, jH_ini
    4503       INTEGER julien
    4504       LOGICAL debutphy
    4505       SAVE step_sca,test_sca,iday
    4506 !$OMP THREADPRIVATE(step_sca,test_sca,iday)
    4507 !$OMP THREADPRIVATE(jH_sca,jH_ini)
    4508 
    4509       IF (debutphy) THEN
    4510         iday=julien
    4511         step_sca=1
    4512         test_sca=0   
    4513         jH_ini=jH_phys
    4514         jH_sca=jH_phys
    4515       ENDIF
    4516 
    4517       IF (test_sca == 0 ) THEN
    4518         ! READ file!!
    4519         call read_scalenc(filescaleparams,paramname_ind,            &
    4520                            nbreg_ind,step_sca,                      &
    4521                            scale_param_ind)
    4522         call read_scalenc(filescaleparams,paramname_bb,            &
    4523                            nbreg_bb,step_sca,                      &
    4524                            scale_param_bb)
    4525         call read_scalenc(filescaleparams,paramname_ff,            &
    4526                            nbreg_ff,step_sca,                      &
    4527                            scale_param_ff)
    4528         call read_scalenc(filescaleparams,paramname_dustacc,            &
    4529                            nbreg_dustacc,step_sca,                      &
    4530                            scale_param_dustacc)
    4531         call read_scalenc(filescaleparams,paramname_dustcoa,            &
    4532                            nbreg_dustcoa,step_sca,                      &
    4533                            scale_param_dustcoa)
    4534         call read_scalenc(filescaleparams,paramname_dustsco,            &
    4535                            nbreg_dustsco,step_sca,                      &
    4536                            scale_param_dustsco)
    4537         call read_scalenc(filescaleparams,paramname_wstarBL,            &
    4538                            nbreg_wstardustBL,step_sca,                    &
    4539                            param_wstarBLperregion)
    4540         call read_scalenc(filescaleparams,paramname_wstarWAKE,          &
    4541                            nbreg_wstardustWAKE,step_sca,                    &
    4542                            param_wstarWAKEperregion)
    4543         call read_scalenc(filescaleparams,paramname_ssacc,              &
    4544                            nbreg_ssacc,step_sca,                        &
    4545                            scale_param_ssacc_tmp)
    4546         call read_scalenc(filescaleparams,paramname_sscoa,              &
    4547                            nbreg_sscoa,step_sca,                        &
    4548                            scale_param_sscoa_tmp)
    4549          scale_param_ssacc=scale_param_ssacc_tmp(1)
    4550          scale_param_sscoa=scale_param_sscoa_tmp(1)
    4551 
    4552        !print *,'JEREADFILE',julien,jH_phys
    4553         step_sca= step_sca + 1
    4554         test_sca=1
    4555       ENDIF
    4556 
    4557       jH_sca=jH_sca+pdtphys/(24.*3600.)
    4558       IF (jH_sca>(sca_resol)/24.) THEN
    4559           test_sca=0
    4560           jH_sca=jH_ini
    4561       ENDIF
    4562 
    4563       END SUBROUTINE readscaleparamsnc_spl
    4564 
    4565       SUBROUTINE read_scalenc(filescaleparams,paramname,nbreg,step_sca, &
    4566                           scale_param)
    4567 
    4568       USE mod_grid_phy_lmdz
    4569       USE mod_phys_lmdz_para
    4570       USE netcdf, ONLY:nf90_open,nf90_close,nf90_inq_varid,nf90_nowrite,nf90_noerr,nf90_get_var
    4571       IMPLICIT NONE
    4572 
    4573       CHARACTER*800 filescaleparams
    4574       CHARACTER*100 paramname
    4575       INTEGER nbreg, step_sca
    4576       REAL scale_param(nbreg)
    4577       !local vars
    4578       integer nid,ierr,nvarid
    4579       real rcode,auxreal
    4580       integer start(4),count(4), status
    4581 !      local
    4582       integer debutread,countread
    4583       CHARACTER*104 varname
    4584       CHARACTER*2 aux_2s
    4585       integer i, j, ig
    4586 !$OMP MASTER
    4587       IF (is_mpi_root .AND. is_omp_root) THEN
    4588           !nci=NCOPN(trim(adjustl(filescaleparams)),NCNOWRIT,rcode)
    4589          ierr = nf90_open (trim(adjustl(filescaleparams)),nf90_nowrite, nid)
    4590           if (ierr == nf90_noerr) THEN
    4591           debutread=step_sca
    4592           countread=1
    4593 
    4594            do i=1,nbreg
    4595             WRITE(aux_2s,'(i2.2)') i
    4596             varname= trim(adjustl(paramname))//aux_2s
    4597             print *,varname
    4598             ierr = nf90_inq_varid (nid,trim(adjustl(varname)), nvarid)
    4599             ierr = nf90_get_var (nid, nvarid, auxreal, debutread, countread)
    4600             IF (ierr /= nf90_noerr) THEN
    4601              PRINT*, 'Pb de lecture pour modvalues'
    4602        print *,'JE  scale_var, step_sca',trim(adjustl(varname)),step_sca
    4603              CALL HANDLE_ERR(ierr)
    4604              print *,'error ierr= ',ierr
    4605              CALL exit(1)
    4606             call abort_gcm('read_scalenc','error reading variable',1)
    4607       ENDIF
    4608 
    4609             print *,auxreal
    4610             scale_param(i)=auxreal
    4611            enddo
    4612 
    4613             ierr = nf90_close(nid)
    4614           else
    4615            print *,'File '//trim(adjustl(filescaleparams))//' not found'
    4616             print *,'doing nothing...'
    4617           endif
    4618 
    4619       ENDIF ! mpi_root
    4620 !$OMP END MASTER
    4621 !$OMP BARRIER
    4622 !      CALL scatter(var local _glo,var local) o algo asi
    4623       call bcast(scale_param)
    4624       END SUBROUTINE read_scalenc
    4625 
    4626 
    4627      
    4628       END MODULE
     4311      CLOSE(1)
     4312    ENDIF
     4313    CALL bcast(scale_param)
     4314    !      print *,'holaaaaaaaaaaaa'
     4315    !      print *,scale_param
     4316
     4317  END SUBROUTINE readscaleparams_spl
     4318
     4319  SUBROUTINE readscaleparamsnc_spl(scale_param_ind, &
     4320          nbreg_ind, paramname_ind, &
     4321          scale_param_ff, nbreg_ff, paramname_ff, &
     4322          scale_param_bb, nbreg_bb, paramname_bb, &
     4323          scale_param_dustacc, nbreg_dustacc, paramname_dustacc, &
     4324          scale_param_dustcoa, nbreg_dustcoa, paramname_dustcoa, &
     4325          scale_param_dustsco, nbreg_dustsco, paramname_dustsco, &
     4326          param_wstarBLperregion, nbreg_wstardustBL, paramname_wstarBL, &
     4327          param_wstarWAKEperregion, nbreg_wstardustWAKE, paramname_wstarWAKE, &
     4328          scale_param_ssacc, paramname_ssacc, &
     4329          scale_param_sscoa, paramname_sscoa, &
     4330          filescaleparams, julien, jH_phys, pdtphys, debutphy)
     4331    !      SUBROUTINE readscaleparamsnc_spl(scale_param, nbreg, &
     4332    !                                        filescaleparams,paramname,&
     4333    !                                        julien,jH_phys, pdtphys,debutphy)
     4334    USE mod_grid_phy_lmdz
     4335    USE mod_phys_lmdz_para
     4336    IMPLICIT NONE
     4337
     4338    CHARACTER*800 filescaleparams
     4339    CHARACTER*100 paramname_ind, paramname_ff, paramname_bb
     4340    CHARACTER*100 paramname_dustacc, paramname_dustcoa
     4341    CHARACTER*100 paramname_dustsco
     4342    CHARACTER*100 paramname_ssacc
     4343    CHARACTER*100 paramname_sscoa
     4344    CHARACTER*100 paramname_wstarBL
     4345    CHARACTER*100 paramname_wstarWAKE
     4346
     4347    INTEGER nbreg, iday
     4348    INTEGER nbreg_ind, nbreg_ff, nbreg_bb, nbreg_dustacc
     4349    INTEGER nbreg_dustcoa, nbreg_dustsco, nbreg_wstardustBL
     4350    INTEGER  nbreg_wstardustWAKE
     4351    INTEGER, PARAMETER :: nbreg_ssacc = 1
     4352    INTEGER, PARAMETER :: nbreg_sscoa = 1
     4353    REAL, PARAMETER :: sca_resol = 24. ! resolution of scalig params in hours
     4354    REAL scale_param_ind(nbreg_ind)
     4355    REAL scale_param_bb(nbreg_bb)
     4356    REAL scale_param_ff(nbreg_ff)
     4357    REAL scale_param_dustacc(nbreg_dustacc)
     4358    REAL scale_param_dustcoa(nbreg_dustcoa)
     4359    REAL scale_param_dustsco(nbreg_dustsco)
     4360    REAL param_wstarBLperregion(nbreg_wstardustBL)
     4361    REAL param_wstarWAKEperregion(nbreg_wstardustWAKE)
     4362    REAL scale_param_ssacc
     4363    REAL scale_param_ssacc_tmp(nbreg_ssacc)
     4364    REAL scale_param_sscoa
     4365    REAL scale_param_sscoa_tmp(nbreg_sscoa)
     4366
     4367    INTEGER k, step_sca, test_sca
     4368    REAL :: jH_phys, pdtphys
     4369    REAL, SAVE :: jH_sca, jH_ini
     4370    INTEGER julien
     4371    LOGICAL debutphy
     4372    SAVE step_sca, test_sca, iday
     4373    !$OMP THREADPRIVATE(step_sca,test_sca,iday)
     4374    !$OMP THREADPRIVATE(jH_sca,jH_ini)
     4375
     4376    IF (debutphy) THEN
     4377      iday = julien
     4378      step_sca = 1
     4379      test_sca = 0
     4380      jH_ini = jH_phys
     4381      jH_sca = jH_phys
     4382    ENDIF
     4383
     4384    IF (test_sca == 0) THEN
     4385      ! READ file!!
     4386      call read_scalenc(filescaleparams, paramname_ind, &
     4387              nbreg_ind, step_sca, &
     4388              scale_param_ind)
     4389      call read_scalenc(filescaleparams, paramname_bb, &
     4390              nbreg_bb, step_sca, &
     4391              scale_param_bb)
     4392      call read_scalenc(filescaleparams, paramname_ff, &
     4393              nbreg_ff, step_sca, &
     4394              scale_param_ff)
     4395      call read_scalenc(filescaleparams, paramname_dustacc, &
     4396              nbreg_dustacc, step_sca, &
     4397              scale_param_dustacc)
     4398      call read_scalenc(filescaleparams, paramname_dustcoa, &
     4399              nbreg_dustcoa, step_sca, &
     4400              scale_param_dustcoa)
     4401      call read_scalenc(filescaleparams, paramname_dustsco, &
     4402              nbreg_dustsco, step_sca, &
     4403              scale_param_dustsco)
     4404      call read_scalenc(filescaleparams, paramname_wstarBL, &
     4405              nbreg_wstardustBL, step_sca, &
     4406              param_wstarBLperregion)
     4407      call read_scalenc(filescaleparams, paramname_wstarWAKE, &
     4408              nbreg_wstardustWAKE, step_sca, &
     4409              param_wstarWAKEperregion)
     4410      call read_scalenc(filescaleparams, paramname_ssacc, &
     4411              nbreg_ssacc, step_sca, &
     4412              scale_param_ssacc_tmp)
     4413      call read_scalenc(filescaleparams, paramname_sscoa, &
     4414              nbreg_sscoa, step_sca, &
     4415              scale_param_sscoa_tmp)
     4416      scale_param_ssacc = scale_param_ssacc_tmp(1)
     4417      scale_param_sscoa = scale_param_sscoa_tmp(1)
     4418
     4419      !print *,'JEREADFILE',julien,jH_phys
     4420      step_sca = step_sca + 1
     4421      test_sca = 1
     4422    ENDIF
     4423
     4424    jH_sca = jH_sca + pdtphys / (24. * 3600.)
     4425    IF (jH_sca>(sca_resol) / 24.) THEN
     4426      test_sca = 0
     4427      jH_sca = jH_ini
     4428    ENDIF
     4429
     4430  END SUBROUTINE readscaleparamsnc_spl
     4431
     4432  SUBROUTINE read_scalenc(filescaleparams, paramname, nbreg, step_sca, &
     4433          scale_param)
     4434
     4435    USE mod_grid_phy_lmdz
     4436    USE mod_phys_lmdz_para
     4437    USE netcdf, ONLY : nf90_open, nf90_close, nf90_inq_varid, nf90_nowrite, nf90_noerr, nf90_get_var
     4438    IMPLICIT NONE
     4439
     4440    CHARACTER*800 filescaleparams
     4441    CHARACTER*100 paramname
     4442    INTEGER nbreg, step_sca
     4443    REAL scale_param(nbreg)
     4444    !local vars
     4445    integer nid, ierr, nvarid
     4446    real rcode, auxreal
     4447    integer start(4), count(4), status
     4448    !      local
     4449    CHARACTER*104 varname
     4450    CHARACTER*2 aux_2s
     4451    integer i, j, ig
     4452    !$OMP MASTER
     4453    IF (is_mpi_root .AND. is_omp_root) THEN
     4454      ierr = nf90_open(trim(adjustl(filescaleparams)), nf90_nowrite, nid)
     4455      if (ierr == nf90_noerr) THEN
     4456        do i = 1, nbreg
     4457          WRITE(aux_2s, '(i2.2)') i
     4458          varname = trim(adjustl(paramname)) // aux_2s
     4459          print *, varname
     4460          ierr = nf90_inq_varid(nid, trim(adjustl(varname)), nvarid)
     4461          ierr = nf90_get_var(nid, nvarid, auxreal, [step_sca])
     4462          IF (ierr /= nf90_noerr) THEN
     4463            PRINT*, 'Pb de lecture pour modvalues'
     4464            print *, 'JE  scale_var, step_sca', trim(adjustl(varname)), step_sca
     4465            CALL HANDLE_ERR(ierr)
     4466            print *, 'error ierr= ', ierr
     4467            CALL exit(1)
     4468            call abort_gcm('read_scalenc', 'error reading variable', 1)
     4469          ENDIF
     4470
     4471          print *, auxreal
     4472          scale_param(i) = auxreal
     4473        enddo
     4474
     4475        ierr = nf90_close(nid)
     4476      else
     4477        print *, 'File ' // trim(adjustl(filescaleparams)) // ' not found'
     4478        print *, 'doing nothing...'
     4479      endif
     4480
     4481    ENDIF ! mpi_root
     4482    !$OMP END MASTER
     4483    !$OMP BARRIER
     4484    !      CALL scatter(var local _glo,var local) o algo asi
     4485    call bcast(scale_param)
     4486  END SUBROUTINE read_scalenc
     4487
     4488
     4489END MODULE

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_dust.f90

    r5098 r5099  
    1       SUBROUTINE read_dust(debutphy, step, nbjour, dust_ec)
    2       USE dimphy
    3       USE mod_grid_phy_lmdz
    4       USE mod_phys_lmdz_para
    5       USE netcdf, ONLY:nf90_get_var
    6       IMPLICIT NONE
    7 c
    8       INCLUDE "dimensions.h"
    9       INCLUDE "paramet.h"
    10 c
    11       INTEGER step, nbjour
    12       LOGICAL debutphy
    13       real dust_ec(klon)
    14       real dust_ec_glo(klon_glo)
    15 c
    16 c as      real dust_nc(iip1,jjp1)
    17       real dust_nc_glo(nbp_lon+1,nbp_lat)
    18       real rcode
    19       integer ncid1, varid1, ncid2, varid2
     1SUBROUTINE read_dust(debutphy, step, nbjour, dust_ec)
     2  USE dimphy
     3  USE mod_grid_phy_lmdz
     4  USE mod_phys_lmdz_para
     5  USE netcdf, ONLY : nf90_get_var, nf90_nowrite, nf90_open, nf90_inq_varid
     6  IMPLICIT NONE
    207
    21       save ncid1, varid1, ncid2, varid2
    22 !$OMP THREADPRIVATE(ncid1, varid1, ncid2, varid2)
    23       integer start(4),count(4), status
    24       integer i, j, ig
    25 c
    26 !$OMP MASTER
    27       IF (is_mpi_root .AND. is_omp_root) THEN
    28       if (debutphy) then
    29 c
    30          ncid1=NCOPN('dust.nc',NCNOWRIT,rcode)
    31          varid1=NCVID(ncid1,'EMISSION',rcode)
    32 c
    33       endif
    34 c
    35       start(1)=1
    36       start(2)=1
    37       start(4)=0
     8  INCLUDE "dimensions.h"
     9  INCLUDE "paramet.h"
    3810
    39 !      count(1)=iip1
    40       count(1)=nbp_lon+1
    41 !      count(2)=jjp1
    42       count(2)=nbp_lat
    43       count(3)=1
    44       count(4)=0
    45 c
    46       start(3)=step
     11  INTEGER :: step, nbjour
     12  LOGICAL :: debutphy
     13  real :: dust_ec(klon)
     14  real :: dust_ec_glo(klon_glo)
    4715
    48       status=nf90_get_var(ncid1,varid1,dust_nc_glo,start,count)
     16  ! as      real dust_nc(iip1,jjp1)
     17  real :: dust_nc_glo(nbp_lon + 1, nbp_lat)
     18  integer :: rcode
     19  integer :: ncid1, varid1, ncid2, varid2
    4920
    50 !      call correctbid(iim,jjp1,dust_nc)
    51       call correctbid(nbp_lon,nbp_lat,dust_nc_glo)
    52 c
    53 c--upside down + physical grid
    54 c
    55 c--OB=change jjp1 to 1 here ;
    56 c----AS: OB's change is needed if lats N to S (90 to -90) in dust.nc
    57 !      dust_ec(1)=MAX(dust_nc(1,jjp1),0.0)
    58       dust_ec_glo(1)=MAX(dust_nc_glo(1,nbp_lat),0.0)
    59       ig=2
    60 !      DO j=2,jjm
    61       DO j=2,nbp_lat-1
    62 !         DO i = 1, iim
    63          DO i = 1, nbp_lon
    64 c--OB=change jjp1+1-j to j here
    65 !           dust_ec(ig)=MAX(dust_nc(i,jjp1+1-j),0.0)
    66            dust_ec_glo(ig)=MAX(dust_nc_glo(i,nbp_lat+1-j),0.0)
    67            ig=ig+1
    68          ENDDO
     21  save ncid1, varid1, ncid2, varid2
     22  !$OMP THREADPRIVATE(ncid1, varid1, ncid2, varid2)
     23  integer :: start(4), count(4), status
     24  integer :: i, j, ig
     25
     26  !$OMP MASTER
     27  IF (is_mpi_root .AND. is_omp_root) THEN
     28    if (debutphy) then
     29      ncid1 = nf90_open('dust.nc', nf90_nowrite, rcode)
     30      varid1 = nf90_inq_varid(ncid1, 'EMISSION', rcode)
     31    endif
     32
     33    start(1) = 1
     34    start(2) = 1
     35    start(4) = 0
     36
     37    count(1) = nbp_lon + 1
     38    count(2) = nbp_lat
     39    count(3) = 1
     40    count(4) = 0
     41
     42    start(3) = step
     43
     44    status = nf90_get_var(ncid1, varid1, dust_nc_glo, start, count)
     45
     46    ! call correctbid(iim,jjp1,dust_nc)
     47    call correctbid(nbp_lon, nbp_lat, dust_nc_glo)
     48
     49    !--upside down + physical grid
     50
     51    !--OB=change jjp1 to 1 here ;
     52    !----AS: OB's change is needed if lats N to S (90 to -90) in dust.nc
     53    !  dust_ec(1)=MAX(dust_nc(1,jjp1),0.0)
     54    dust_ec_glo(1) = MAX(dust_nc_glo(1, nbp_lat), 0.0)
     55    ig = 2
     56    ! DO j=2,jjm
     57    DO j = 2, nbp_lat - 1
     58      ! DO i = 1, iim
     59      DO i = 1, nbp_lon
     60        !--OB=change jjp1+1-j to j here
     61        ! dust_ec(ig)=MAX(dust_nc(i,jjp1+1-j),0.0)
     62        dust_ec_glo(ig) = MAX(dust_nc_glo(i, nbp_lat + 1 - j), 0.0)
     63        ig = ig + 1
    6964      ENDDO
    70 c--OB=change second 1 to jjp1 here
    71       dust_ec_glo(ig)=MAX(dust_nc_glo(1,1),0.0)
    72 !      end if master
    73       ENDIF
    74 !$OMP END MASTER
    75 !$OMP BARRIER
    76       CALL scatter(dust_ec_glo,dust_ec)
    77 c
    78       RETURN
    79       END
     65    ENDDO
     66    !--OB=change second 1 to jjp1 here
     67    dust_ec_glo(ig) = MAX(dust_nc_glo(1, 1), 0.0)
     68    ! end if master
     69  ENDIF
     70  !$OMP END MASTER
     71  !$OMP BARRIER
     72  CALL scatter(dust_ec_glo, dust_ec)
     73
     74  RETURN
     75END SUBROUTINE read_dust

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_newemissions.F

    r5082 r5099  
    2727
    2828      INCLUDE "dimensions.h"
    29 c      INCLUDE 'dimphy.h'     
    30       INCLUDE 'paramet.h'     
     29      INCLUDE 'paramet.h'
    3130      INCLUDE 'chem.h'     
    3231      INCLUDE 'chem_spla.h'
    33 c      INCLUDE 'indicesol.h'
    3432
    3533      logical debutphy, lafinphy, edgar

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_surface.F90

    r5088 r5099  
    55! ------
    66       USE ioipsl
    7 !       USE comgeomphy
    87       USE dimphy
    98       USE mod_grid_phy_lmdz
    109       USE mod_phys_lmdz_para
    1110       USE iophy
    12        USE netcdf, ONLY:nf90_inq_varid,nf90_noerr,nf90_get_var
     11       USE netcdf, ONLY:nf90_inq_varid,nf90_noerr,nf90_get_var,nf90_nowrite,nf90_inq_varid,nf90_open
    1312       IMPLICIT NONE
    1413
    … …  
    1817       character*10 name
    1918       character*10 varname
    20 !
     19
    2120       real tmp_dyn(iip1,jjp1)
    2221       real tmp_dyn_glo(nbp_lon+1,nbp_lat)
    23 !       real tmp_dyn_glo(nbp_lon,nbp_lat)
    2422       REAL tmp_dyn_invers(iip1,jjp1)
    2523       real tmp_dyn_invers_glo(nbp_lon+1,nbp_lat)
    26 !       real tmp_dyn_invers_glo(nbp_lon,nbp_lat)
    2724       real tmp_fi(klon)
    2825       real tmp_fi_glo(klon_glo)
    2926       real surfa(klon,5)
    3027       real surfa_glo(klon_glo,5)
    31 !
     28
    3229       integer ncid
    3330       integer varid
    34        real rcode
     31       integer rcode
    3532       integer start(2),count(2),status
    3633       integer i,j,l,ig
    … …  
    4946
    5047       print*,'Lecture du fichier donnees_lisa.nc'
    51        ncid=NCOPN('donnees_lisa.nc',NCNOWRIT,rcode)
     48       ncid=nf90_open('donnees_lisa.nc',nf90_nowrite,rcode)
    5249
    5350!JE20140526<<: check if are inversed or not the latitude grid in donnes_lisa
    … …  
    7269!      endj(1)=jjp1
    7370      endj(1)=nbp_lat
    74       varid=NCVID(ncid,latstr,rcode)
     71      varid=nf90_inq_varid(ncid,latstr,rcode)
    7572
    7673          status=nf90_get_var(ncid,varid,lats_glo,startj,endj)
    … …  
    8986          varname=trim(name)//str1
    9087       print*,'lecture variable:',varname
    91           varid=NCVID(ncid,trim(varname),rcode)
    92 !          varid=NCVID(ncid,varname,rcode)
     88          varid=nf90_inq_varid(ncid,trim(varname),rcode)
    9389
    9490!  dimensions pour les champs scalaires et le vent zonal
    … …  
    135131!JE20140526>>
    136132!      call dump2d(iim,jjm-1,tmp_fi(2),'tmp_fi   ')
    137 !
     133
    138134          DO j=1,klon_glo
    139135
    … …  
    141137
    142138          ENDDO ! Fin de recopie du tableau
    143 !
     139
    144140       ENDDO ! Fin boucle 1 a 5
    145141       print*,'Passage Grille Dyn -> Phys'

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_vent.f90

    r5098 r5099  
    1       SUBROUTINE read_vent(debutphy, step, nbjour, u10m_ec, v10m_ec)
    2       USE dimphy
    3       USE mod_grid_phy_lmdz
    4       USE mod_phys_lmdz_para
    5       USE netcdf, ONLY: nf90_get_var
    6 !      USE write_field_phy
    7       IMPLICIT NONE
    8       INCLUDE "dimensions.h"
    9 c       INCLUDE "dimphy.h"
    10       INCLUDE "paramet.h"
    11 c
    12       INTEGER step, nbjour
    13       LOGICAL debutphy
    14       real u10m_ec(klon), v10m_ec(klon)
    15       real u10m_ec_glo(klon_glo), v10m_ec_glo(klon_glo)
    16 c
    17 !      real u10m_nc(iip1,jjp1) !, v10m_nc(iip1,jjm) ! dim 97x72
    18 !      real v10m_nc(iip1,jjp1)  ! dim 97x73
    19       real u10m_nc_glo(nbp_lon+1,nbp_lat) !, v10m_nc(iip1,jjm) ! dim 97x72
    20       real v10m_nc_glo(nbp_lon+1,nbp_lat)  ! dim 97x73
    21       real rcode
    22       integer ncidu1, varidu1, ncidv1, varidv1
    23       save ncidu1, varidu1, ncidv1, varidv1
    24 !$OMP THREADPRIVATE(ncidu1, varidu1, ncidv1, varidv1)
    25       integer start(4),count(4), status
    26       integer i, j, ig
     1SUBROUTINE read_vent(debutphy, step, nbjour, u10m_ec, v10m_ec)
     2  USE dimphy
     3  USE mod_grid_phy_lmdz
     4  USE mod_phys_lmdz_para
     5  USE netcdf, ONLY : nf90_get_var, nf90_open, nf90_inq_varid, nf90_nowrite
     6  IMPLICIT NONE
     7  INCLUDE "dimensions.h"
     8  INCLUDE "paramet.h"
     9
     10  INTEGER :: step, nbjour
     11  LOGICAL :: debutphy
     12  real :: u10m_ec(klon), v10m_ec(klon)
     13  real :: u10m_ec_glo(klon_glo), v10m_ec_glo(klon_glo)
     14
     15  !  real u10m_nc(iip1,jjp1) !, v10m_nc(iip1,jjm) ! dim 97x72
     16  !  real v10m_nc(iip1,jjp1)  ! dim 97x73
     17  real :: u10m_nc_glo(nbp_lon + 1, nbp_lat) !, v10m_nc(iip1,jjm) ! dim 97x72
     18  real :: v10m_nc_glo(nbp_lon + 1, nbp_lat)  ! dim 97x73
     19  integer :: rcode
     20  integer :: ncidu1, varidu1, ncidv1, varidv1
     21  save ncidu1, varidu1, ncidv1, varidv1
     22  !$OMP THREADPRIVATE(ncidu1, varidu1, ncidv1, varidv1)
     23  integer :: start(4), count(4), status
     24  integer :: i, j, ig
     25
     26  !$OMP MASTER
     27  IF (is_mpi_root .AND. is_omp_root) THEN
     28    if (debutphy) then
     29
     30      ncidu1 = nf90_open('u10m.nc', nf90_nowrite, rcode)
     31      varidu1 = nf90_inq_varid(ncidu1, 'U10M', rcode)
     32      ncidv1 = nf90_open('v10m.nc', nf90_nowrite, rcode)
     33      varidv1 = nf90_inq_varid(ncidv1, 'V10M', rcode)
     34
     35    endif
     36
     37    start(1) = 1
     38    start(2) = 1
     39    start(4) = 0
     40
     41    ! count(1)=iip1
     42    count(1) = nbp_lon + 1
     43    ! count(2)=jjp1
     44    count(2) = nbp_lat
     45    count(3) = 1
     46    count(4) = 0
     47
     48    start(3) = step
     49
     50    status = nf90_get_var(ncidu1, varidu1, u10m_nc_glo, start, count)
     51
     52    status = nf90_get_var(ncidv1, varidv1, v10m_nc_glo, start, count)
    2753
    2854
    29 c
    30 !$OMP MASTER
    31       IF (is_mpi_root .AND. is_omp_root) THEN
    32       if (debutphy) then
    33 c
    34          ncidu1=NCOPN('u10m.nc',NCNOWRIT,rcode)
    35          varidu1=NCVID(ncidu1,'U10M',rcode)
    36          ncidv1=NCOPN('v10m.nc',NCNOWRIT,rcode)
    37          varidv1=NCVID(ncidv1,'V10M',rcode)
    38 c
    39       endif
    40 c
    41       start(1)=1
    42       start(2)=1
    43       start(4)=0
     55    ! print *,'beforebidcor u10m_nc', u10m_nc(1,jjp1)
     56    ! print *,'beforebidcor v10m_nc', v10m_nc(1,jjp1)
    4457
    45 !      count(1)=iip1
    46       count(1)=nbp_lon+1
    47 !      count(2)=jjp1
    48       count(2)=nbp_lat
    49       count(3)=1
    50       count(4)=0
    51 c
    52       start(3)=step
     58    !  print *,status
     59    ! call correctbid(iim,jjp1,u10m_nc)
     60    ! call correctbid(iim,jjp1,v10m_nc)
     61    call correctbid(nbp_lon, nbp_lat, u10m_nc_glo)
     62    call correctbid(nbp_lon, nbp_lat, v10m_nc_glo)
    5363
    54       status=nf90_get_var(ncidu1,varidu1,u10m_nc_glo,start,count)
     64    ! print *,'afterbidcor u10m_nc', u10m_nc(1,jjp1)
     65    ! print *,'afterbidcor v10m_nc', v10m_nc(1,jjp1)
    5566
    56       status=nf90_get_var(ncidv1,varidv1,v10m_nc_glo,start,count)
     67    !--upside down + physical grid
     68
     69    !  u10m_ec(1)=u10m_nc(1,jjp1)
     70    !  v10m_ec(1)=v10m_nc(1,jjp1)
     71    u10m_ec_glo(1) = u10m_nc_glo(1, nbp_lat)
     72    v10m_ec_glo(1) = v10m_nc_glo(1, nbp_lat)
     73    ig = 2
     74    ! DO j=2,jjm
     75    !    DO i = 1, iim
     76    DO j = 2, nbp_lat - 1
     77      DO i = 1, nbp_lon
     78        ! u10m_ec(ig)=u10m_nc(i,jjp1+1-j)
     79        ! v10m_ec(ig)=v10m_nc(i,jjp1+1-j)
     80        u10m_ec_glo(ig) = u10m_nc_glo(i, nbp_lat + 1 - j)
     81        v10m_ec_glo(ig) = v10m_nc_glo(i, nbp_lat + 1 - j)
     82        ig = ig + 1
     83        ! print *,u10m_ec(ig) ,v10m_ec(ig)
     84      ENDDO
     85    ENDDO
     86    u10m_ec_glo(ig) = u10m_nc_glo(1, 1)
     87    v10m_ec_glo(ig) = v10m_nc_glo(1, 1)
    5788
    5889
    59 !      print *,'beforebidcor u10m_nc', u10m_nc(1,jjp1)
    60 !      print *,'beforebidcor v10m_nc', v10m_nc(1,jjp1)
     90    ! end if master
     91  ENDIF
     92  !$OMP END MASTER
     93  !$OMP BARRIER
     94  CALL scatter(u10m_ec_glo, u10m_ec)
     95  CALL scatter(v10m_ec_glo, v10m_ec)
    6196
    62 !       print *,status
    63 !      call correctbid(iim,jjp1,u10m_nc)
    64 !      call correctbid(iim,jjp1,v10m_nc)
    65       call correctbid(nbp_lon,nbp_lat,u10m_nc_glo)
    66       call correctbid(nbp_lon,nbp_lat,v10m_nc_glo)
     97  ! print *,'JE  tamagno viento ig= ', ig
     98  ! print *,'READ_VENT U = ',SUM(u10m_ec),MINVAL(u10m_ec),
     99  ! .                                      MAXVAL(u10m_ec)
     100  !  print *,'READ_VENT V = ',SUM(v10m_ec),MINVAL(v10m_ec),
     101  ! .                                      MAXVAL(v10m_ec)
     102  !   print *,'u v 1 ', u10m_ec(1),v10m_ec(1)
     103  !   print *,'u v klon ', u10m_ec(klon),v10m_ec(klon)
     104  RETURN
     105END SUBROUTINE read_vent
    67106
    68 !      print *,'afterbidcor u10m_nc', u10m_nc(1,jjp1)
    69 !      print *,'afterbidcor v10m_nc', v10m_nc(1,jjp1)
    70 c
    71 c--upside down + physical grid
    72 c
    73 !      u10m_ec(1)=u10m_nc(1,jjp1)
    74 !      v10m_ec(1)=v10m_nc(1,jjp1)
    75       u10m_ec_glo(1)=u10m_nc_glo(1,nbp_lat)
    76       v10m_ec_glo(1)=v10m_nc_glo(1,nbp_lat)
    77       ig=2
    78 !      DO j=2,jjm
    79 !         DO i = 1, iim
    80       DO j=2,nbp_lat-1
    81          DO i = 1, nbp_lon
    82 !           u10m_ec(ig)=u10m_nc(i,jjp1+1-j)
    83 !           v10m_ec(ig)=v10m_nc(i,jjp1+1-j)
    84            u10m_ec_glo(ig)=u10m_nc_glo(i,nbp_lat+1-j)
    85            v10m_ec_glo(ig)=v10m_nc_glo(i,nbp_lat+1-j)
    86            ig=ig+1
    87 !         print *,u10m_ec(ig) ,v10m_ec(ig)
    88          ENDDO
    89       ENDDO
    90       u10m_ec_glo(ig)=u10m_nc_glo(1,1)
    91       v10m_ec_glo(ig)=v10m_nc_glo(1,1)
     107! added by JE from the nh SPLA, dyn3d/read_reanalyse.F which is not available any more
     108subroutine correctbid(iim, nl, x)
     109  integer :: iim, nl
     110  real :: x(iim + 1, nl)
     111  integer :: i, l
     112  real :: zz
    92113
     114  do l = 1, nl
     115    do i = 2, iim - 1
     116      if(abs(x(i, l))>1.e10) then
     117        zz = 0.5 * (x(i - 1, l) + x(i + 1, l))
     118        ! print*,'correction ',i,l,x(i,l),zz
     119        x(i, l) = zz
     120      endif
     121    enddo
     122  enddo
    93123
    94 !      end if master
    95       ENDIF
    96 !$OMP END MASTER
    97 !$OMP BARRIER
    98       CALL scatter(u10m_ec_glo,u10m_ec)
    99       CALL scatter(v10m_ec_glo,v10m_ec)
    100 
    101 !      print *,'JE  tamagno viento ig= ', ig
    102 !      print *,'READ_VENT U = ',SUM(u10m_ec),MINVAL(u10m_ec),
    103 !     .                                      MAXVAL(u10m_ec)
    104 !      print *,'READ_VENT V = ',SUM(v10m_ec),MINVAL(v10m_ec),
    105 !     .                                      MAXVAL(v10m_ec)
    106 !       print *,'u v 1 ', u10m_ec(1),v10m_ec(1)
    107 !       print *,'u v klon ', u10m_ec(klon),v10m_ec(klon)
    108       RETURN
    109       END
    110 
    111 c added by JE from the nh SPLA, dyn3d/read_reanalyse.F which is not available any more
    112       subroutine correctbid(iim,nl,x)
    113       integer iim,nl
    114       real x(iim+1,nl)
    115       integer i,l
    116       real zz
    117 
    118       do l=1,nl
    119          do i=2,iim-1
    120             if(abs(x(i,l))>1.e10) then
    121                zz=0.5*(x(i-1,l)+x(i+1,l))
    122 c              print*,'correction ',i,l,x(i,l),zz
    123                x(i,l)=zz
    124             endif
    125          enddo
    126       enddo
    127 
    128       return
    129       end
     124  return
     125end subroutine correctbid
    130126
    131127

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/satellite_out_spla.F90

    r5082 r5099  
    2828!            pdtphys,rlon,rlat,masque_polder)
    2929!  ENDIF
    30 !
     30
    3131!  DO i=1,klon
    3232!    IF ( masque_polder(i) .EQ. 1 ) THEN

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/sediment_mod.F

    r5082 r5099  
    1414      INCLUDE "dimensions.h"
    1515      INCLUDE "chem.h"
    16 c       INCLUDE "dimphy.h"
    1716      INCLUDE "YOMCST.h"
    1817      INCLUDE "YOECUMF.h"

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/spla_output_dat.h

    r2752 r5099  
    172172!      (/ 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)',  &
    173173!         't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)' /))
    174 !
     174
    175175!  type(ctrl_out),save :: o_taue670_aqua     = ctrl_out((/ 4, 4, 4, 10, 10, 10, 10, 10, 10, 10 /), &
    176176!  'taue670_aqua','Tau ext 670 aqua','', &
    177177!      (/ 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)',  &
    178178!         't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)' /))
    179 !
     179
    180180!  type(ctrl_out),save :: o_taue670_terra     = ctrl_out((/ 4, 4, 4, 10, 10, 10, 10, 10, 10, 10 /), &
    181181!  'taue670_terra','Tau ext 670 terra','', &
    182182!      (/ 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)',  &
    183183!         't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)' /))
    184 !
     184
    185185!  type(ctrl_out),save :: o_taue865_aqua     = ctrl_out((/ 4, 4, 4, 10, 10, 10, 10, 10, 10, 10 /), &
    186186!  'taue865_aqua','Tau ext 865 aqua','', &
    187187!      (/ 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)',  &
    188188!         't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)', 't_max(X)' /))
    189 !
     189
    190190!  type(ctrl_out),save :: o_taue865_terra     = ctrl_out((/ 4, 4, 4, 10, 10, 10, 10, 10, 10, 10 /), &
    191191!  'taue865_terra','Tau ext 865 terra','', &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/spla_output_write.h

    r3786 r5099  
    183183!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    184184! histrac_spl
    185 !
     185
    186186      CALL histwrite_phy( o_fluxbb              , fluxbb               )
    187187      CALL histwrite_phy( o_fluxff              , fluxff               )

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/splaeropt_5wv_rrtm.f90

    r5098 r5099  
    1 !
     1
    22! $Id: splaeropt_5wv_rrtm.F90 2644 2016-10-02 16:55:08Z oboucher $
    3 !
    43
    5 SUBROUTINE SPLAEROPT_5WV_RRTM(  &
    6    zdm, zdh, tr_seri, RHcl,    &
    7    tausum, tau )
     4SUBROUTINE SPLAEROPT_5WV_RRTM(&
     5        zdm, zdh, tr_seri, RHcl, &
     6        tausum, tau)
    87
    98  USE DIMPHY
    109  USE aero_mod
    11   USE infotrac_phy, ONLY: nqtot, nbtr, tracers
    12   USE phys_local_var_mod, ONLY: od550aer,od865aer,ec550aer,od550lt1aer
    13   !
     10  USE infotrac_phy, ONLY : nqtot, nbtr, tracers
     11  USE phys_local_var_mod, ONLY : od550aer, od865aer, ec550aer, od550lt1aer
     12
    1413  ! Olivier Boucher Jan 2017
    1514  ! Based on Mie routines on ciclad CMIP6
    16   !
     15
    1716  IMPLICIT NONE
    18   !
     17
    1918  ! Input arguments:
    20   !
    21   REAL, DIMENSION(klon,klev), INTENT(IN)  :: zdh      !--m
    22   REAL, DIMENSION(klon,klev), INTENT(IN)  :: zdm      !--kg/m2
    23   REAL, DIMENSION(klon,klev), INTENT(IN)  :: RHcl     ! humidite relative ciel clair
    24   REAL, DIMENSION(klon,klev,nbtr), INTENT(IN) :: tr_seri
    25   !
     19
     20  REAL, DIMENSION(klon, klev), INTENT(IN) :: zdh      !--m
     21  REAL, DIMENSION(klon, klev), INTENT(IN) :: zdm      !--kg/m2
     22  REAL, DIMENSION(klon, klev), INTENT(IN) :: RHcl     ! humidite relative ciel clair
     23  REAL, DIMENSION(klon, klev, nbtr), INTENT(IN) :: tr_seri
     24
    2625  ! Output arguments:
    27   !
    28   REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)      :: tausum
    29   REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT) :: tau
    30   !
     26
     27  REAL, DIMENSION(klon, nwave, naero_tot), INTENT(OUT) :: tausum
     28  REAL, DIMENSION(klon, klev, nwave, naero_tot), INTENT(OUT) :: tau
     29
    3130  ! Local
    32   !
     31
    3332  INTEGER, PARAMETER :: las = nwave_sw
    3433  LOGICAL :: soluble
    35  
     34
    3635  INTEGER :: i, k, m, iq, itr, irh, aerindex
    3736  INTEGER :: spsol, spinsol, la
    38   INTEGER :: RH_num(klon,klev)
     37  INTEGER :: RH_num(klon, klev)
    3938  INTEGER, PARAMETER :: la443 = 1
    4039  INTEGER, PARAMETER :: la550 = 2
    … …  
    4241  INTEGER, PARAMETER :: la765 = 4
    4342  INTEGER, PARAMETER :: la865 = 5
    44   INTEGER, PARAMETER :: nbre_RH=12
    45   INTEGER, PARAMETER :: naero_soluble=2
    46   INTEGER, PARAMETER :: naero_insoluble=2
    47   INTEGER, PARAMETER :: naero=naero_soluble+naero_insoluble
     43  INTEGER, PARAMETER :: nbre_RH = 12
     44  INTEGER, PARAMETER :: naero_soluble = 2
     45  INTEGER, PARAMETER :: naero_insoluble = 2
     46  INTEGER, PARAMETER :: naero = naero_soluble + naero_insoluble
    4847
    49   REAL, PARAMETER :: RH_tab(nbre_RH)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
    50   REAL, PARAMETER :: RH_MAX=95.
    51   REAL :: delta(klon,klev), rh(klon,klev)
     48  REAL, PARAMETER :: RH_tab(nbre_RH) = (/0., 10., 20., 30., 40., 50., 60., 70., 80., 85., 90., 95./)
     49  REAL, PARAMETER :: RH_MAX = 95.
     50  REAL :: delta(klon, klev), rh(klon, klev)
    5251  REAL :: tau_ae5wv_int   ! Intermediate computation of epaisseur optique aerosol
    5352  REAL :: zrho
    5453  CHARACTER*20 modname
    55  
     54
    5655  ! Soluble components 1-accumulation mode soluble; 2- seasalt coarse
    57   REAL :: alpha_aers_5wv(nbre_RH,las,naero_soluble)   ! Ext. coeff. ** m2/g
     56  REAL :: alpha_aers_5wv(nbre_RH, las, naero_soluble)   ! Ext. coeff. ** m2/g
    5857  ! Insoluble components 1- Dust: 2- BC; 3- POM
    59   REAL :: alpha_aeri_5wv(las,naero_insoluble)         ! Ext. coeff. ** m2/g
    60   !
     58  REAL :: alpha_aeri_5wv(las, naero_insoluble)         ! Ext. coeff. ** m2/g
     59
    6160  ! Proprietes optiques
    62   !
     61
    6362  REAL :: fact_RH(nbre_RH)
    6463
    65 ! From here on we look at the optical parameters at 5 wavelengths: 
    66 ! 443nm, 550, 670, 765 and 865 nm
    67 !                                   le 12 AVRIL 2006
    68 ! 
    69  DATA alpha_aers_5wv/ &
    70                            ! accumulation mode (sulfate+2% bc) soluble
    71        4.632, 4.632, 4.632, 4.632, 6.206, 6.827, 7.616, 8.716,10.514,12.025,14.688,21.539, &
    72        3.981, 3.981, 3.981, 3.981, 5.346, 5.923, 6.662, 7.704, 9.437,10.914,13.562,20.591, &
    73        3.265, 3.265, 3.265, 3.265, 4.400, 4.909, 5.565, 6.500, 8.081, 9.449,11.943,18.791, &
    74        2.761, 2.761, 2.761, 2.761, 3.731, 4.182, 4.767, 5.606, 7.041, 8.294,10.610,17.118, &
    75        2.307, 2.307, 2.307, 2.307, 3.129, 3.522, 4.034, 4.774, 6.052, 7.180, 9.286,15.340, &
     64  ! From here on we look at the optical parameters at 5 wavelengths:
     65  ! 443nm, 550, 670, 765 and 865 nm
     66  !                                   le 12 AVRIL 2006
    7667
    77                            ! seasalt seasalt Coarse Soluble (CS)     
    78        0.576, 0.690, 0.738, 0.789, 0.855, 0.935, 1.046, 1.212, 1.512, 1.785, 2.258, 3.449, &
    79        0.595, 0.713, 0.763, 0.814, 0.880, 0.963, 1.079, 1.248, 1.550, 1.826, 2.306, 3.507, &
    80        0.617, 0.738, 0.789, 0.842, 0.911, 0.996, 1.113, 1.286, 1.592, 1.871, 2.369, 3.562, &
    81        0.632, 0.755, 0.808, 0.862, 0.931, 1.018, 1.140, 1.316, 1.626, 1.909, 2.409, 3.622, &
    82        0.645, 0.771, 0.825, 0.880, 0.951, 1.039, 1.164, 1.344, 1.661, 1.948, 2.455, 3.682  /
     68  DATA alpha_aers_5wv/ &
     69          ! accumulation mode (sulfate+2% bc) soluble
     70          4.632, 4.632, 4.632, 4.632, 6.206, 6.827, 7.616, 8.716, 10.514, 12.025, 14.688, 21.539, &
     71          3.981, 3.981, 3.981, 3.981, 5.346, 5.923, 6.662, 7.704, 9.437, 10.914, 13.562, 20.591, &
     72          3.265, 3.265, 3.265, 3.265, 4.400, 4.909, 5.565, 6.500, 8.081, 9.449, 11.943, 18.791, &
     73          2.761, 2.761, 2.761, 2.761, 3.731, 4.182, 4.767, 5.606, 7.041, 8.294, 10.610, 17.118, &
     74          2.307, 2.307, 2.307, 2.307, 3.129, 3.522, 4.034, 4.774, 6.052, 7.180, 9.286, 15.340, &
     75
     76          ! seasalt seasalt Coarse Soluble (CS)
     77          0.576, 0.690, 0.738, 0.789, 0.855, 0.935, 1.046, 1.212, 1.512, 1.785, 2.258, 3.449, &
     78          0.595, 0.713, 0.763, 0.814, 0.880, 0.963, 1.079, 1.248, 1.550, 1.826, 2.306, 3.507, &
     79          0.617, 0.738, 0.789, 0.842, 0.911, 0.996, 1.113, 1.286, 1.592, 1.871, 2.369, 3.562, &
     80          0.632, 0.755, 0.808, 0.862, 0.931, 1.018, 1.140, 1.316, 1.626, 1.909, 2.409, 3.622, &
     81          0.645, 0.771, 0.825, 0.880, 0.951, 1.039, 1.164, 1.344, 1.661, 1.948, 2.455, 3.682  /
    8382
    8483  DATA alpha_aeri_5wv/ &
    85                                  ! coarse dust insoluble
    86        0.605, 0.611, 0.661, 0.714, 0.760, &
    87                                  ! super coarse insoluble
    88        0.153, 0.156, 0.158, 0.157, 0.161 /
    89   !
     84          ! coarse dust insoluble
     85          0.605, 0.611, 0.661, 0.714, 0.760, &
     86          ! super coarse insoluble
     87          0.153, 0.156, 0.158, 0.157, 0.161 /
     88
    9089  ! Initialisations
    91   tausum(:,:,:)=0.
    92   tau(:,:,:,:)=0.
     90  tausum(:, :, :) = 0.
     91  tau(:, :, :, :) = 0.
    9392
    94   modname='splaeropt_5wv_rrtm'
     93  modname = 'splaeropt_5wv_rrtm'
    9594
    9695  IF (naero>naero_tot) THEN
    97     CALL abort_physic(modname,'Too many aerosol types',1)
     96    CALL abort_physic(modname, 'Too many aerosol types', 1)
    9897  ENDIF
    9998
    100   DO irh=1,nbre_RH-1
    101     fact_RH(irh)=1./(RH_tab(irh+1)-RH_tab(irh))
     99  DO irh = 1, nbre_RH - 1
     100    fact_RH(irh) = 1. / (RH_tab(irh + 1) - RH_tab(irh))
    102101  ENDDO
    103    
    104   DO k=1, klev
    105     DO i=1, klon
    106       rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX)
    107       RH_num(i,k) = INT( rh(i,k)/10. + 1.)
    108       IF (rh(i,k)>85.) RH_num(i,k)=10
    109       IF (rh(i,k)>90.) RH_num(i,k)=11
    110       delta(i,k)=(rh(i,k)-RH_tab(RH_num(i,k)))*fact_RH(RH_num(i,k))
     102
     103  DO k = 1, klev
     104    DO i = 1, klon
     105      rh(i, k) = MIN(RHcl(i, k) * 100., RH_MAX)
     106      RH_num(i, k) = INT(rh(i, k) / 10. + 1.)
     107      IF (rh(i, k)>85.) RH_num(i, k) = 10
     108      IF (rh(i, k)>90.) RH_num(i, k) = 11
     109      delta(i, k) = (rh(i, k) - RH_tab(RH_num(i, k))) * fact_RH(RH_num(i, k))
    111110    ENDDO
    112111  ENDDO
    … …  
    115114  DO iq = 1, nqtot
    116115    IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    117     itr = itr+1
     116    itr = itr + 1
    118117    SELECT CASE(tracers(iq)%name)
    119       CASE('PREC'); CYCLE                                  !--precursor
    120       CASE('FINE'); soluble=.TRUE.;  spsol=1; aerindex=1   !--fine mode accumulation mode
    121       CASE('COSS'); soluble=.TRUE.;  spsol=2; aerindex=2   !--coarse mode sea salt
    122       CASE('CODU'); soluble=.FALSE.; spinsol=1; aerindex=3   !--coarse mode dust
    123       CASE('SCDU'); soluble=.FALSE.; spinsol=2; aerindex=4   !--super coarse mode dust
    124       CASE DEFAULT; CALL abort_physic(modname,'I cannot do aerosol optics for '//tracers(iq)%name,1)
     118    CASE('PREC'); CYCLE                                  !--precursor
     119    CASE('FINE'); soluble = .TRUE.;  spsol = 1; aerindex = 1   !--fine mode accumulation mode
     120    CASE('COSS'); soluble = .TRUE.;  spsol = 2; aerindex = 2   !--coarse mode sea salt
     121    CASE('CODU'); soluble = .FALSE.; spinsol = 1; aerindex = 3   !--coarse mode dust
     122    CASE('SCDU'); soluble = .FALSE.; spinsol = 2; aerindex = 4   !--super coarse mode dust
     123    CASE DEFAULT; CALL abort_physic(modname, 'I cannot do aerosol optics for ' // tracers(iq)%name, 1)
    125124    END SELECT
    126125
    127     DO la=1,las
     126    DO la = 1, las
    128127
    129128      !--only 550 and 865 nm are used
    … …  
    132131      IF (soluble) THEN  !--soluble aerosol with RH dependence
    133132
    134         DO k=1, klev
    135           DO i=1, klon
    136             tau_ae5wv_int = alpha_aers_5wv(RH_num(i,k),la,spsol)+DELTA(i,k)* &
    137                            (alpha_aers_5wv(RH_num(i,k)+1,la,spsol) - &
    138                             alpha_aers_5wv(RH_num(i,k),la,spsol))
    139             tau(i,k,la,aerindex) = tr_seri(i,k,itr)*zdm(i,k)*tau_ae5wv_int
    140             tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
     133        DO k = 1, klev
     134          DO i = 1, klon
     135            tau_ae5wv_int = alpha_aers_5wv(RH_num(i, k), la, spsol) + DELTA(i, k) * &
     136                    (alpha_aers_5wv(RH_num(i, k) + 1, la, spsol) - &
     137                            alpha_aers_5wv(RH_num(i, k), la, spsol))
     138            tau(i, k, la, aerindex) = tr_seri(i, k, itr) * zdm(i, k) * tau_ae5wv_int
     139            tausum(i, la, aerindex) = tausum(i, la, aerindex) + tau(i, k, la, aerindex)
    141140          ENDDO
    142141        ENDDO
    … …  
    144143      ELSE               !--cases of insoluble aerosol
    145144
    146         DO k=1, klev
    147           DO i=1, klon
    148             tau_ae5wv_int = alpha_aeri_5wv(la,spinsol)
    149             tau(i,k,la,aerindex) = tr_seri(i,k,itr)*zdm(i,k)*tau_ae5wv_int
    150             tausum(i,la,aerindex)= tausum(i,la,aerindex)+tau(i,k,la,aerindex)
     145        DO k = 1, klev
     146          DO i = 1, klon
     147            tau_ae5wv_int = alpha_aeri_5wv(la, spinsol)
     148            tau(i, k, la, aerindex) = tr_seri(i, k, itr) * zdm(i, k) * tau_ae5wv_int
     149            tausum(i, la, aerindex) = tausum(i, la, aerindex) + tau(i, k, la, aerindex)
    151150          ENDDO
    152151        ENDDO
    … …  
    157156  ENDDO     ! Boucle sur les masses de traceurs
    158157
    159 !--AOD calculations for diagnostics
    160   od550aer(:)=SUM(tausum(:,la550,1:naero),dim=2)
    161   od865aer(:)=SUM(tausum(:,la865,1:naero),dim=2)
     158  !--AOD calculations for diagnostics
     159  od550aer(:) = SUM(tausum(:, la550, 1:naero), dim = 2)
     160  od865aer(:) = SUM(tausum(:, la865, 1:naero), dim = 2)
    162161
    163 !--extinction coefficient for diagnostic
    164   ec550aer(:,:)=SUM(tau(:,:,la550,1:naero),dim=3)/zdh(:,:)
     162  !--extinction coefficient for diagnostic
     163  ec550aer(:, :) = SUM(tau(:, :, la550, 1:naero), dim = 3) / zdh(:, :)
    165164
    166 !--aod for particles lower than 1 micron
    167   od550lt1aer(:)=tausum(:,la550,1)+tausum(:,la550,2)*0.3+tausum(:,la550,3)*0.2
     165  !--aod for particles lower than 1 micron
     166  od550lt1aer(:) = tausum(:, la550, 1) + tausum(:, la550, 2) * 0.3 + tausum(:, la550, 3) * 0.2
    168167
    169168END SUBROUTINE SPLAEROPT_5WV_RRTM

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/splaeropt_6bands_rrtm.f90

    r5098 r5099  
    1 !
     1
    22! $Id: splaeropt_6bands_rrtm.F90 2644 2016-10-02 16:55:08Z oboucher $
    3 !
    4 SUBROUTINE SPLAEROPT_6BANDS_RRTM ( &
    5      zdm, tr_seri, RHcl,          &
    6      tau_allaer, piz_allaer, cg_allaer )
     3
     4SUBROUTINE SPLAEROPT_6BANDS_RRTM (&
     5        zdm, tr_seri, RHcl, &
     6        tau_allaer, piz_allaer, cg_allaer)
    77
    88  USE dimphy
    99  USE aero_mod
    10   USE infotrac_phy, ONLY: nqtot, nbtr, tracers
    11   USE phys_local_var_mod, ONLY: abs550aer
     10  USE infotrac_phy, ONLY : nqtot, nbtr, tracers
     11  USE phys_local_var_mod, ONLY : abs550aer
    1212
    1313  ! Olivier Boucher Jan 2017
    1414  ! based on Mie routines on ciclad CMIP6
    15   !
     15
    1616  IMPLICIT NONE
    1717
    1818  INCLUDE "clesphys.h"
    19   !
     19
    2020  ! Input arguments:
    21   !
    22   REAL, DIMENSION(klon,klev),     INTENT(IN) :: zdm        !--hauteur des couches en kg/m2
    23   REAL, DIMENSION(klon,klev),     INTENT(IN) :: RHcl       ! humidite relative ciel clair
    24   REAL, DIMENSION(klon,klev,nbtr),INTENT(IN) :: tr_seri
    25   !
     21
     22  REAL, DIMENSION(klon, klev), INTENT(IN) :: zdm        !--hauteur des couches en kg/m2
     23  REAL, DIMENSION(klon, klev), INTENT(IN) :: RHcl       ! humidite relative ciel clair
     24  REAL, DIMENSION(klon, klev, nbtr), INTENT(IN) :: tr_seri
     25
    2626  ! Output arguments:
    2727  ! 2= total aerosols
    2828  ! 1= natural aerosols
    29   !
    30   REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: tau_allaer ! epaisseur optique aerosol
    31   REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: piz_allaer ! single scattering albedo aerosol
    32   REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: cg_allaer  ! asymmetry parameter aerosol
    33   !
     29
     30  REAL, DIMENSION(klon, klev, 2, nbands_sw_rrtm), INTENT(OUT) :: tau_allaer ! epaisseur optique aerosol
     31  REAL, DIMENSION(klon, klev, 2, nbands_sw_rrtm), INTENT(OUT) :: piz_allaer ! single scattering albedo aerosol
     32  REAL, DIMENSION(klon, klev, 2, nbands_sw_rrtm), INTENT(OUT) :: cg_allaer  ! asymmetry parameter aerosol
     33
    3434  ! Local
    35   !
     35
    3636  LOGICAL :: soluble
    3737  INTEGER :: i, k, irh, iq, itr, inu
    3838  INTEGER :: aerindex, spsol, spinsol
    39   INTEGER :: RH_num(klon,klev)
    40 
    41   INTEGER, PARAMETER :: naero_soluble=2    ! 1- accumulation soluble; 2- coarse soluble
    42   INTEGER, PARAMETER :: naero_insoluble=2  ! 1- coarse dust; 2- supercoarse dust
    43   INTEGER, PARAMETER :: naero=naero_soluble+naero_insoluble
    44 
    45   INTEGER, PARAMETER :: nbre_RH=12
    46   REAL,PARAMETER :: RH_tab(nbre_RH)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./)
    47   REAL, PARAMETER :: RH_MAX=95.
    48   REAL :: delta(klon,klev), rh(klon,klev)
     39  INTEGER :: RH_num(klon, klev)
     40
     41  INTEGER, PARAMETER :: naero_soluble = 2    ! 1- accumulation soluble; 2- coarse soluble
     42  INTEGER, PARAMETER :: naero_insoluble = 2  ! 1- coarse dust; 2- supercoarse dust
     43  INTEGER, PARAMETER :: naero = naero_soluble + naero_insoluble
     44
     45  INTEGER, PARAMETER :: nbre_RH = 12
     46  REAL, PARAMETER :: RH_tab(nbre_RH) = (/0., 10., 20., 30., 40., 50., 60., 70., 80., 85., 90., 95./)
     47  REAL, PARAMETER :: RH_MAX = 95.
     48  REAL :: delta(klon, klev), rh(klon, klev)
    4949  REAL :: tau_ae2b_int   ! Intermediate computation of epaisseur optique aerosol
    5050  REAL :: piz_ae2b_int   ! Intermediate computation of Single scattering albedo
    5151  REAL :: cg_ae2b_int    ! Intermediate computation of Assymetry parameter
    5252  REAL :: fact_RH(nbre_RH), tmp_var
    53   !
    54   REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: tau_ae
    55   REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: piz_ae
    56   REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: cg_ae
    57   !
     53
     54  REAL, DIMENSION(klon, klev, naero_tot, nbands_sw_rrtm) :: tau_ae
     55  REAL, DIMENSION(klon, klev, naero_tot, nbands_sw_rrtm) :: piz_ae
     56  REAL, DIMENSION(klon, klev, naero_tot, nbands_sw_rrtm) :: cg_ae
     57
    5858  ! Proprietes optiques
    59   !
    60   REAL:: alpha_aers_6bands(nbre_RH,nbands_sw_rrtm,naero_soluble)   !--unit m2/g aer
    61   REAL:: alpha_aeri_6bands(nbands_sw_rrtm,naero_insoluble)         !--unit m2/g aer
    62   REAL:: cg_aers_6bands(nbre_RH,nbands_sw_rrtm,naero_soluble)      !--unitless
    63   REAL:: cg_aeri_6bands(nbands_sw_rrtm,naero_insoluble)            !--unitless
    64   REAL:: piz_aers_6bands(nbre_RH,nbands_sw_rrtm,naero_soluble)     !--unitless
    65   REAL:: piz_aeri_6bands(nbands_sw_rrtm,naero_insoluble)           !--unitless
    66   !
     59
     60  REAL :: alpha_aers_6bands(nbre_RH, nbands_sw_rrtm, naero_soluble)   !--unit m2/g aer
     61  REAL :: alpha_aeri_6bands(nbands_sw_rrtm, naero_insoluble)         !--unit m2/g aer
     62  REAL :: cg_aers_6bands(nbre_RH, nbands_sw_rrtm, naero_soluble)      !--unitless
     63  REAL :: cg_aeri_6bands(nbands_sw_rrtm, naero_insoluble)            !--unitless
     64  REAL :: piz_aers_6bands(nbre_RH, nbands_sw_rrtm, naero_soluble)     !--unitless
     65  REAL :: piz_aeri_6bands(nbands_sw_rrtm, naero_insoluble)           !--unitless
     66
    6767  REAL, PARAMETER :: tau_min = 1.e-8
    6868  CHARACTER*20 modname
    6969
    70 !***************************************************************************
    71 !--the order of the soluble   species has to follow the spsol   index below
    72 !--the order of the insoluble species has to follow the spinsol index below
    73 
    74   DATA alpha_aers_6bands/  & 
    75        ! accumulation (sulfate+2% bc) mode soluble
    76   5.212, 5.212, 5.212, 5.212, 6.973, 7.581, 8.349, 9.400,11.078,12.463,14.857,20.837, &
    77   4.906, 4.906, 4.906, 4.906, 6.568, 7.195, 7.989, 9.088,10.869,12.354,14.951,21.545, &
    78   3.940, 3.940, 3.940, 3.940, 5.291, 5.861, 6.591, 7.620, 9.332,10.791,13.410,20.370, &
    79   2.292, 2.292, 2.292, 2.292, 3.105, 3.493, 3.996, 4.724, 5.978, 7.084, 9.146,15.067, &
    80   0.762, 0.762, 0.762, 0.762, 1.050, 1.201, 1.401, 1.699, 2.232, 2.721, 3.675, 6.678, &
    81   0.090, 0.090, 0.090, 0.090, 0.122, 0.141, 0.166, 0.204, 0.275, 0.344, 0.484, 0.973, &
    82         ! coarse seasalt
    83   0.547, 0.657, 0.705, 0.754, 0.817, 0.896, 1.008, 1.169, 1.456, 1.724, 2.199, 3.358, &
    84   0.566, 0.679, 0.727, 0.776, 0.840, 0.920, 1.032, 1.196, 1.492, 1.760, 2.238, 3.416, &
    85   0.596, 0.714, 0.764, 0.816, 0.882, 0.965, 1.081, 1.250, 1.552, 1.828, 2.310, 3.509, &
    86   0.644, 0.771, 0.825, 0.880, 0.951, 1.040, 1.164, 1.345, 1.666, 1.957, 2.462, 3.700, &
    87   0.640, 0.772, 0.829, 0.887, 0.965, 1.061, 1.198, 1.398, 1.758, 2.085, 2.658, 4.031, &
    88   0.452, 0.562, 0.609, 0.659, 0.728, 0.813, 0.938, 1.125, 1.471, 1.797, 2.384, 3.855  /
    89 
    90   DATA alpha_aeri_6bands/  & 
    91        ! coarse dust insoluble
    92   0.594, 0.610, 0.619, 0.762, 0.791, 0.495, &
    93        ! supercoarse dust insoluble
    94   0.151, 0.152, 0.155, 0.159, 0.168, 0.167  /
     70  !***************************************************************************
     71  !--the order of the soluble   species has to follow the spsol   index below
     72  !--the order of the insoluble species has to follow the spinsol index below
     73
     74  DATA alpha_aers_6bands/  &
     75          ! accumulation (sulfate+2% bc) mode soluble
     76          5.212, 5.212, 5.212, 5.212, 6.973, 7.581, 8.349, 9.400, 11.078, 12.463, 14.857, 20.837, &
     77          4.906, 4.906, 4.906, 4.906, 6.568, 7.195, 7.989, 9.088, 10.869, 12.354, 14.951, 21.545, &
     78          3.940, 3.940, 3.940, 3.940, 5.291, 5.861, 6.591, 7.620, 9.332, 10.791, 13.410, 20.370, &
     79          2.292, 2.292, 2.292, 2.292, 3.105, 3.493, 3.996, 4.724, 5.978, 7.084, 9.146, 15.067, &
     80          0.762, 0.762, 0.762, 0.762, 1.050, 1.201, 1.401, 1.699, 2.232, 2.721, 3.675, 6.678, &
     81          0.090, 0.090, 0.090, 0.090, 0.122, 0.141, 0.166, 0.204, 0.275, 0.344, 0.484, 0.973, &
     82          ! coarse seasalt
     83          0.547, 0.657, 0.705, 0.754, 0.817, 0.896, 1.008, 1.169, 1.456, 1.724, 2.199, 3.358, &
     84          0.566, 0.679, 0.727, 0.776, 0.840, 0.920, 1.032, 1.196, 1.492, 1.760, 2.238, 3.416, &
     85          0.596, 0.714, 0.764, 0.816, 0.882, 0.965, 1.081, 1.250, 1.552, 1.828, 2.310, 3.509, &
     86          0.644, 0.771, 0.825, 0.880, 0.951, 1.040, 1.164, 1.345, 1.666, 1.957, 2.462, 3.700, &
     87          0.640, 0.772, 0.829, 0.887, 0.965, 1.061, 1.198, 1.398, 1.758, 2.085, 2.658, 4.031, &
     88          0.452, 0.562, 0.609, 0.659, 0.728, 0.813, 0.938, 1.125, 1.471, 1.797, 2.384, 3.855  /
     89
     90  DATA alpha_aeri_6bands/  &
     91          ! coarse dust insoluble
     92          0.594, 0.610, 0.619, 0.762, 0.791, 0.495, &
     93          ! supercoarse dust insoluble
     94          0.151, 0.152, 0.155, 0.159, 0.168, 0.167  /
    9595
    9696  DATA cg_aers_6bands/ &
    97        ! accumulation (sulfate+2% bc) mode soluble
    98   0.692, 0.692, 0.692, 0.692, 0.735, 0.739, 0.744, 0.749, 0.755, 0.759, 0.765, 0.772, &
    99   0.690, 0.690, 0.690, 0.690, 0.736, 0.740, 0.746, 0.752, 0.760, 0.765, 0.771, 0.779, &
    100   0.678, 0.678, 0.678, 0.678, 0.727, 0.733, 0.740, 0.748, 0.759, 0.766, 0.775, 0.787, &
    101   0.641, 0.641, 0.641, 0.641, 0.692, 0.700, 0.710, 0.721, 0.736, 0.746, 0.760, 0.781, &
    102   0.553, 0.553, 0.553, 0.553, 0.603, 0.615, 0.627, 0.643, 0.664, 0.678, 0.699, 0.735, &
    103   0.343, 0.343, 0.343, 0.343, 0.386, 0.399, 0.414, 0.433, 0.460, 0.480, 0.510, 0.569, &
    104        ! seasalt coarse Soluble
    105   0.754, 0.770, 0.776, 0.781, 0.784, 0.791, 0.797, 0.805, 0.815, 0.822, 0.828, 0.840, &
    106   0.736, 0.753, 0.759, 0.765, 0.771, 0.778, 0.785, 0.793, 0.804, 0.811, 0.820, 0.831, &
    107   0.716, 0.735, 0.742, 0.748, 0.754, 0.762, 0.769, 0.778, 0.789, 0.796, 0.807, 0.819, &
    108   0.704, 0.725, 0.733, 0.739, 0.745, 0.752, 0.759, 0.768, 0.778, 0.784, 0.792, 0.803, &
    109   0.716, 0.737, 0.744, 0.751, 0.756, 0.763, 0.770, 0.777, 0.786, 0.790, 0.795, 0.800, &
    110   0.688, 0.730, 0.741, 0.751, 0.761, 0.771, 0.782, 0.795, 0.810, 0.820, 0.833, 0.849  /
     97          ! accumulation (sulfate+2% bc) mode soluble
     98          0.692, 0.692, 0.692, 0.692, 0.735, 0.739, 0.744, 0.749, 0.755, 0.759, 0.765, 0.772, &
     99          0.690, 0.690, 0.690, 0.690, 0.736, 0.740, 0.746, 0.752, 0.760, 0.765, 0.771, 0.779, &
     100          0.678, 0.678, 0.678, 0.678, 0.727, 0.733, 0.740, 0.748, 0.759, 0.766, 0.775, 0.787, &
     101          0.641, 0.641, 0.641, 0.641, 0.692, 0.700, 0.710, 0.721, 0.736, 0.746, 0.760, 0.781, &
     102          0.553, 0.553, 0.553, 0.553, 0.603, 0.615, 0.627, 0.643, 0.664, 0.678, 0.699, 0.735, &
     103          0.343, 0.343, 0.343, 0.343, 0.386, 0.399, 0.414, 0.433, 0.460, 0.480, 0.510, 0.569, &
     104          ! seasalt coarse Soluble
     105          0.754, 0.770, 0.776, 0.781, 0.784, 0.791, 0.797, 0.805, 0.815, 0.822, 0.828, 0.840, &
     106          0.736, 0.753, 0.759, 0.765, 0.771, 0.778, 0.785, 0.793, 0.804, 0.811, 0.820, 0.831, &
     107          0.716, 0.735, 0.742, 0.748, 0.754, 0.762, 0.769, 0.778, 0.789, 0.796, 0.807, 0.819, &
     108          0.704, 0.725, 0.733, 0.739, 0.745, 0.752, 0.759, 0.768, 0.778, 0.784, 0.792, 0.803, &
     109          0.716, 0.737, 0.744, 0.751, 0.756, 0.763, 0.770, 0.777, 0.786, 0.790, 0.795, 0.800, &
     110          0.688, 0.730, 0.741, 0.751, 0.761, 0.771, 0.782, 0.795, 0.810, 0.820, 0.833, 0.849  /
    111111
    112112  DATA cg_aeri_6bands/ &
    113        ! coarse dust insoluble
    114   0.801, 0.779, 0.709, 0.698, 0.710, 0.687, &
    115        ! super coarse dust insoluble
    116   0.862, 0.871, 0.852, 0.799, 0.758, 0.651  /
     113          ! coarse dust insoluble
     114          0.801, 0.779, 0.709, 0.698, 0.710, 0.687, &
     115          ! super coarse dust insoluble
     116          0.862, 0.871, 0.852, 0.799, 0.758, 0.651  /
    117117
    118118  DATA piz_aers_6bands/&
    119        ! accumulation (sulfate+2% bc) mode soluble
    120   0.941, 0.941, 0.941, 0.941, 0.958, 0.961, 0.965, 0.969, 0.974, 0.977, 0.981, 0.987, &
    121   0.941, 0.941, 0.941, 0.941, 0.959, 0.963, 0.967, 0.971, 0.976, 0.979, 0.983, 0.988, &
    122   0.953, 0.953, 0.953, 0.953, 0.967, 0.971, 0.974, 0.978, 0.982, 0.984, 0.988, 0.992, &
    123   0.955, 0.955, 0.955, 0.955, 0.969, 0.972, 0.976, 0.980, 0.984, 0.986, 0.989, 0.994, &
    124   0.936, 0.936, 0.936, 0.936, 0.955, 0.961, 0.966, 0.972, 0.978, 0.982, 0.987, 0.993, &
    125   0.792, 0.792, 0.792, 0.792, 0.848, 0.867, 0.887, 0.907, 0.931, 0.944, 0.960, 0.980, &
    126        ! seasalt coarse soluble
    127   1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.001, 1.000, &
    128   1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
    129   1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
    130   1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
    131   0.994, 0.994, 0.995, 0.995, 0.995, 0.995, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, &
    132   0.976, 0.867, 0.837, 0.814, 0.796, 0.774, 0.754, 0.735, 0.713, 0.702, 0.690, 0.675  /
     119          ! accumulation (sulfate+2% bc) mode soluble
     120          0.941, 0.941, 0.941, 0.941, 0.958, 0.961, 0.965, 0.969, 0.974, 0.977, 0.981, 0.987, &
     121          0.941, 0.941, 0.941, 0.941, 0.959, 0.963, 0.967, 0.971, 0.976, 0.979, 0.983, 0.988, &
     122          0.953, 0.953, 0.953, 0.953, 0.967, 0.971, 0.974, 0.978, 0.982, 0.984, 0.988, 0.992, &
     123          0.955, 0.955, 0.955, 0.955, 0.969, 0.972, 0.976, 0.980, 0.984, 0.986, 0.989, 0.994, &
     124          0.936, 0.936, 0.936, 0.936, 0.955, 0.961, 0.966, 0.972, 0.978, 0.982, 0.987, 0.993, &
     125          0.792, 0.792, 0.792, 0.792, 0.848, 0.867, 0.887, 0.907, 0.931, 0.944, 0.960, 0.980, &
     126          ! seasalt coarse soluble
     127          1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.001, 1.000, &
     128          1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
     129          1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
     130          1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, &
     131          0.994, 0.994, 0.995, 0.995, 0.995, 0.995, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, &
     132          0.976, 0.867, 0.837, 0.814, 0.796, 0.774, 0.754, 0.735, 0.713, 0.702, 0.690, 0.675  /
    133133
    134134  DATA piz_aeri_6bands/ &
    135        ! coarse dust insoluble
    136   0.866, 0.875, 0.915, 0.977, 0.993, 0.971, &
    137        ! super coarse dust insoluble
    138   0.789, 0.749, 0.791, 0.918, 0.970, 0.909  /
    139 !
     135          ! coarse dust insoluble
     136          0.866, 0.875, 0.915, 0.977, 0.993, 0.971, &
     137          ! super coarse dust insoluble
     138          0.789, 0.749, 0.791, 0.918, 0.970, 0.909  /
     139
    140140  spsol = 0
    141   spinsol = 0 
    142 
    143   modname='splaeropt_6bands_rrt'
     141  spinsol = 0
     142
     143  modname = 'splaeropt_6bands_rrt'
    144144
    145145  IF (NSW/=nbands_sw_rrtm) THEN
    146      CALL abort_physic(modname,'Erreur NSW doit etre egal a 6 pour cette routine',1)
     146    CALL abort_physic(modname, 'Erreur NSW doit etre egal a 6 pour cette routine', 1)
    147147  ENDIF
    148148
    149   DO irh=1,nbre_RH-1
    150     fact_RH(irh)=1./(RH_tab(irh+1)-RH_tab(irh))
     149  DO irh = 1, nbre_RH - 1
     150    fact_RH(irh) = 1. / (RH_tab(irh + 1) - RH_tab(irh))
    151151  ENDDO
    152    
    153   DO k=1, klev
    154     DO i=1, klon
    155       rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX)
    156       RH_num(i,k) = INT(rh(i,k)/10. + 1.)
    157       IF (rh(i,k)>85.) RH_num(i,k)=10
    158       IF (rh(i,k)>90.) RH_num(i,k)=11
    159       delta(i,k)=(rh(i,k)-RH_tab(RH_num(i,k)))*fact_RH(RH_num(i,k))
     152
     153  DO k = 1, klev
     154    DO i = 1, klon
     155      rh(i, k) = MIN(RHcl(i, k) * 100., RH_MAX)
     156      RH_num(i, k) = INT(rh(i, k) / 10. + 1.)
     157      IF (rh(i, k)>85.) RH_num(i, k) = 10
     158      IF (rh(i, k)>90.) RH_num(i, k) = 11
     159      delta(i, k) = (rh(i, k) - RH_tab(RH_num(i, k))) * fact_RH(RH_num(i, k))
    160160    ENDDO
    161161  ENDDO
    162162
    163   tau_ae(:,:,:,:)=0.
    164   piz_ae(:,:,:,:)=0.
    165   cg_ae(:,:,:,:)=0.
    166    
     163  tau_ae(:, :, :, :) = 0.
     164  piz_ae(:, :, :, :) = 0.
     165  cg_ae(:, :, :, :) = 0.
     166
    167167  itr = 0
    168168  DO iq = 1, nqtot
    169169    IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    170     itr = itr+1
     170    itr = itr + 1
    171171    SELECT CASE(tracers(iq)%name)
    172       CASE('PREC'); CYCLE                                  !--precursor
    173       CASE('FINE'); soluble=.TRUE.;  spsol=1; aerindex=1   !--fine mode accumulation mode
    174       CASE('COSS'); soluble=.TRUE.;  spsol=2; aerindex=2   !--coarse mode sea salt
    175       CASE('CODU'); soluble=.FALSE.; spinsol=1; aerindex=3   !--coarse mode dust
    176       CASE('SCDU'); soluble=.FALSE.; spinsol=2; aerindex=4   !--super coarse mode dust
    177       CASE DEFAULT; CALL abort_physic(modname,'I cannot do aerosol optics for '//tracers(iq)%name,1)
     172    CASE('PREC'); CYCLE                                  !--precursor
     173    CASE('FINE'); soluble = .TRUE.;  spsol = 1; aerindex = 1   !--fine mode accumulation mode
     174    CASE('COSS'); soluble = .TRUE.;  spsol = 2; aerindex = 2   !--coarse mode sea salt
     175    CASE('CODU'); soluble = .FALSE.; spinsol = 1; aerindex = 3   !--coarse mode dust
     176    CASE('SCDU'); soluble = .FALSE.; spinsol = 2; aerindex = 4   !--super coarse mode dust
     177    CASE DEFAULT; CALL abort_physic(modname, 'I cannot do aerosol optics for ' // tracers(iq)%name, 1)
    178178    END SELECT
    179179
    180180    IF (soluble) THEN ! For aerosol soluble components
    181181
    182          DO k=1, klev
    183            DO i=1, klon
    184 
    185              tmp_var=tr_seri(i,k,itr)*zdm(i,k) !-- g/m2
    186 
    187              DO inu=1,NSW
    188 
    189                tau_ae2b_int= alpha_aers_6bands(RH_num(i,k),inu,spsol)+ &
    190                              delta(i,k)* (alpha_aers_6bands(RH_num(i,k)+1,inu,spsol) - &
    191                              alpha_aers_6bands(RH_num(i,k),inu,spsol))
    192                    
    193                piz_ae2b_int = piz_aers_6bands(RH_num(i,k),inu,spsol) + &
    194                               delta(i,k)* (piz_aers_6bands(RH_num(i,k)+1,inu,spsol) - &
    195                               piz_aers_6bands(RH_num(i,k),inu,spsol))
    196                    
    197                cg_ae2b_int = cg_aers_6bands(RH_num(i,k),inu,spsol) + &
    198                              delta(i,k)* (cg_aers_6bands(RH_num(i,k)+1,inu,spsol) - &
    199                              cg_aers_6bands(RH_num(i,k),inu,spsol))
    200 
    201                tau_ae(i,k,aerindex,inu)    = tmp_var*tau_ae2b_int
    202                piz_ae(i,k,aerindex,inu)    = piz_ae2b_int
    203                cg_ae(i,k,aerindex,inu)    = cg_ae2b_int
    204 
    205              ENDDO
    206            ENDDO
    207          ENDDO
     182      DO k = 1, klev
     183        DO i = 1, klon
     184
     185          tmp_var = tr_seri(i, k, itr) * zdm(i, k) !-- g/m2
     186
     187          DO inu = 1, NSW
     188
     189            tau_ae2b_int = alpha_aers_6bands(RH_num(i, k), inu, spsol) + &
     190                    delta(i, k) * (alpha_aers_6bands(RH_num(i, k) + 1, inu, spsol) - &
     191                            alpha_aers_6bands(RH_num(i, k), inu, spsol))
     192
     193            piz_ae2b_int = piz_aers_6bands(RH_num(i, k), inu, spsol) + &
     194                    delta(i, k) * (piz_aers_6bands(RH_num(i, k) + 1, inu, spsol) - &
     195                            piz_aers_6bands(RH_num(i, k), inu, spsol))
     196
     197            cg_ae2b_int = cg_aers_6bands(RH_num(i, k), inu, spsol) + &
     198                    delta(i, k) * (cg_aers_6bands(RH_num(i, k) + 1, inu, spsol) - &
     199                            cg_aers_6bands(RH_num(i, k), inu, spsol))
     200
     201            tau_ae(i, k, aerindex, inu) = tmp_var * tau_ae2b_int
     202            piz_ae(i, k, aerindex, inu) = piz_ae2b_int
     203            cg_ae(i, k, aerindex, inu) = cg_ae2b_int
     204
     205          ENDDO
     206        ENDDO
     207      ENDDO
    208208
    209209    ELSE    ! For all aerosol insoluble components
    210210
    211        DO k=1, klev
    212          DO i=1, klon
    213 
    214            tmp_var=tr_seri(i,k,itr)*zdm(i,k) !-- g/m2
    215 
    216            DO inu=1,NSW
    217              tau_ae2b_int = alpha_aeri_6bands(inu,spinsol)
    218              piz_ae2b_int = piz_aeri_6bands(inu,spinsol)
    219              cg_ae2b_int = cg_aeri_6bands(inu,spinsol)
    220 
    221              tau_ae(i,k,aerindex,inu) = tmp_var*tau_ae2b_int
    222              piz_ae(i,k,aerindex,inu) = piz_ae2b_int
    223              cg_ae(i,k,aerindex,inu)= cg_ae2b_int
    224            ENDDO
    225          ENDDO
    226        ENDDO
    227 
    228      ENDIF ! soluble / insoluble
     211      DO k = 1, klev
     212        DO i = 1, klon
     213
     214          tmp_var = tr_seri(i, k, itr) * zdm(i, k) !-- g/m2
     215
     216          DO inu = 1, NSW
     217            tau_ae2b_int = alpha_aeri_6bands(inu, spinsol)
     218            piz_ae2b_int = piz_aeri_6bands(inu, spinsol)
     219            cg_ae2b_int = cg_aeri_6bands(inu, spinsol)
     220
     221            tau_ae(i, k, aerindex, inu) = tmp_var * tau_ae2b_int
     222            piz_ae(i, k, aerindex, inu) = piz_ae2b_int
     223            cg_ae(i, k, aerindex, inu) = cg_ae2b_int
     224          ENDDO
     225        ENDDO
     226      ENDDO
     227
     228    ENDIF ! soluble / insoluble
    229229
    230230  ENDDO  ! nbtr
    231231
    232 !--all (natural + anthropogenic) aerosol
    233   tau_allaer(:,:,2,:)=SUM(tau_ae(:,:,1:naero,:),dim=3)
    234   tau_allaer(:,:,2,:)=MAX(tau_allaer(:,:,2,:),tau_min)
    235 
    236   piz_allaer(:,:,2,:)=SUM(tau_ae(:,:,1:naero,:)*piz_ae(:,:,1:naero,:),dim=3)/tau_allaer(:,:,2,:)
    237   piz_allaer(:,:,2,:)=MIN(MAX(piz_allaer(:,:,2,:),0.01),1.0)
    238   WHERE (tau_allaer(:,:,2,:)<=tau_min) piz_allaer(:,:,2,:)=1.0
    239 
    240   cg_allaer(:,:,2,:)=SUM(tau_ae(:,:,1:naero,:)*piz_ae(:,:,1:naero,:)*cg_ae(:,:,1:naero,:),dim=3)/  &
    241                      (tau_allaer(:,:,2,:)*piz_allaer(:,:,2,:))
    242   cg_allaer(:,:,2,:)=MIN(MAX(cg_allaer(:,:,2,:),0.0),1.0)
    243 
    244 !--no aerosol
    245   tau_allaer(:,:,1,:)=tau_min
    246   piz_allaer(:,:,1,:)=1.0
    247   cg_allaer(:,:,1,:)=0.0
    248 
    249 !--waveband 2 and all aerosol (third index = 2)
    250   inu=2
    251   abs550aer(:)=SUM((1-piz_allaer(:,:,2,inu))*tau_allaer(:,:,2,inu),dim=2)
     232  !--all (natural + anthropogenic) aerosol
     233  tau_allaer(:, :, 2, :) = SUM(tau_ae(:, :, 1:naero, :), dim = 3)
     234  tau_allaer(:, :, 2, :) = MAX(tau_allaer(:, :, 2, :), tau_min)
     235
     236  piz_allaer(:, :, 2, :) = SUM(tau_ae(:, :, 1:naero, :) * piz_ae(:, :, 1:naero, :), dim = 3) / tau_allaer(:, :, 2, :)
     237  piz_allaer(:, :, 2, :) = MIN(MAX(piz_allaer(:, :, 2, :), 0.01), 1.0)
     238  WHERE (tau_allaer(:, :, 2, :)<=tau_min) piz_allaer(:, :, 2, :) = 1.0
     239
     240  cg_allaer(:, :, 2, :) = SUM(tau_ae(:, :, 1:naero, :) * piz_ae(:, :, 1:naero, :) * cg_ae(:, :, 1:naero, :), dim = 3) / &
     241          (tau_allaer(:, :, 2, :) * piz_allaer(:, :, 2, :))
     242  cg_allaer(:, :, 2, :) = MIN(MAX(cg_allaer(:, :, 2, :), 0.0), 1.0)
     243
     244  !--no aerosol
     245  tau_allaer(:, :, 1, :) = tau_min
     246  piz_allaer(:, :, 1, :) = 1.0
     247  cg_allaer(:, :, 1, :) = 0.0
     248
     249  !--waveband 2 and all aerosol (third index = 2)
     250  inu = 2
     251  abs550aer(:) = SUM((1 - piz_allaer(:, :, 2, inu)) * tau_allaer(:, :, 2, inu), dim = 2)
    252252
    253253END SUBROUTINE SPLAEROPT_6BANDS_RRTM

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/splaeropt_lw_rrtm.f90

    r5098 r5099  
    1 !
     1
    22! splaeropt_lw_rrtm.F90 2014-05-13 C. Kleinschmitt
    33!                      2016-05-03 O. Boucher
    4 !
     4
    55! This routine feeds aerosol LW properties to RRTM
    66! we only consider absorption (not scattering)
    77
    8 SUBROUTINE SPLAEROPT_LW_RRTM(ok_alw,zdm,tr_seri)
     8SUBROUTINE SPLAEROPT_LW_RRTM(ok_alw, zdm, tr_seri)
    99
    1010  USE dimphy
    1111  USE aero_mod
    12   USE infotrac_phy, ONLY: nqtot, nbtr, tracers
     12  USE infotrac_phy, ONLY : nqtot, nbtr, tracers
    1313  USE phys_state_var_mod, ONLY : tau_aero_lw_rrtm
    14   USE YOERAD, ONLY : NLW
     14  USE lmdz_yoerad, ONLY : NLW
    1515
    1616  IMPLICIT NONE
    1717
    1818  INCLUDE "clesphys.h"
    19   !
     19
    2020  ! Input arguments:
    21   !
     21
    2222  LOGICAL, INTENT(IN) :: ok_alw
    23   REAL, DIMENSION(klon,klev), INTENT(IN)      :: zdm
    24   REAL, DIMENSION(klon,klev,nbtr), INTENT(IN) :: tr_seri
    25   !
     23  REAL, DIMENSION(klon, klev), INTENT(IN) :: zdm
     24  REAL, DIMENSION(klon, klev, nbtr), INTENT(IN) :: tr_seri
     25
    2626  ! Local arguments :
    27   !
    28   INTEGER, PARAMETER :: naero_soluble=2    ! 1- accumulation soluble; 2- coarse soluble
    29   INTEGER, PARAMETER :: naero_insoluble=2  ! 1- coarse dust; 2- supercoarse dust
    30   INTEGER, PARAMETER :: naero=naero_soluble+naero_insoluble
    31   !
     27
     28  INTEGER, PARAMETER :: naero_soluble = 2    ! 1- accumulation soluble; 2- coarse soluble
     29  INTEGER, PARAMETER :: naero_insoluble = 2  ! 1- coarse dust; 2- supercoarse dust
     30  INTEGER, PARAMETER :: naero = naero_soluble + naero_insoluble
     31
    3232  INTEGER inu, itr, iq, spinsol
    3333  CHARACTER*20 modname
    34   !
     34
    3535  !--absorption coefficient for coarse and super-coarse DUST
    36   REAL:: alpha_abs_CIDUST_16bands(nbands_lw_rrtm,naero_insoluble)   !--unit m2/g
     36  REAL :: alpha_abs_CIDUST_16bands(nbands_lw_rrtm, naero_insoluble)   !--unit m2/g
    3737  DATA alpha_abs_CIDUST_16bands /                         &
    38    ! Dust CO insoluble
    39   0.001, 0.003, 0.005, 0.006, 0.011, 0.031, 0.157, 0.102, &
    40   0.017, 0.056, 0.032, 0.008, 0.010, 0.011, 0.013, 0.016, &
    41    ! Dust SC insoluble
    42   0.002, 0.004, 0.007, 0.010, 0.018, 0.043, 0.099, 0.071, &
    43   0.021, 0.056, 0.033, 0.011, 0.013, 0.014, 0.016, 0.018 /
     38          ! Dust CO insoluble
     39          0.001, 0.003, 0.005, 0.006, 0.011, 0.031, 0.157, 0.102, &
     40          0.017, 0.056, 0.032, 0.008, 0.010, 0.011, 0.013, 0.016, &
     41          ! Dust SC insoluble
     42          0.002, 0.004, 0.007, 0.010, 0.018, 0.043, 0.099, 0.071, &
     43          0.021, 0.056, 0.033, 0.011, 0.013, 0.014, 0.016, 0.018 /
    4444
    45   modname='splaeropt_lw_rrtm'
    46   !
     45  modname = 'splaeropt_lw_rrtm'
     46
    4747  IF (NLW/=nbands_lw_rrtm) THEN
    48     CALL abort_physic(modname,'Erreur NLW doit etre egal a 16 pour cette routine',1)
     48    CALL abort_physic(modname, 'Erreur NLW doit etre egal a 16 pour cette routine', 1)
    4949  ENDIF
    50   !
    51   IF (ok_alw) THEN 
    52     !
     50
     51  IF (ok_alw) THEN
     52
    5353    !--initialisation
    5454    tau_aero_lw_rrtm = 0.0
    55     !
    56    
     55
    5756    itr = 0
    5857    DO iq = 1, nqtot
    5958      IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    60       itr = itr+1
     59      itr = itr + 1
    6160      SELECT CASE(tracers(iq)%name)
    62         CASE('PREC','FINE','COSS'); CYCLE                  !--precursor or fine/coarde accumulation mode
    63         CASE('CODU'); spinsol=1                            !--coarse mode dust
    64         CASE('SCDU'); spinsol=2                            !--super coarse mode dust
    65         CASE DEFAULT; CALL abort_physic(modname,'I cannot do aerosol optics for '//tracers(iq)%name,1)
     61      CASE('PREC', 'FINE', 'COSS'); CYCLE                  !--precursor or fine/coarde accumulation mode
     62      CASE('CODU'); spinsol = 1                            !--coarse mode dust
     63      CASE('SCDU'); spinsol = 2                            !--super coarse mode dust
     64      CASE DEFAULT; CALL abort_physic(modname, 'I cannot do aerosol optics for ' // tracers(iq)%name, 1)
    6665      END SELECT
    67       !
    68       DO inu=1,NLW
    69         !
     66
     67      DO inu = 1, NLW
     68
    7069        !--total aerosol
    71         tau_aero_lw_rrtm(:,:,2,inu) = tau_aero_lw_rrtm(:,:,2,inu) + tr_seri(:,:,itr)*zdm(:,:)*alpha_abs_CIDUST_16bands(inu,spinsol)
     70        tau_aero_lw_rrtm(:, :, 2, inu) = tau_aero_lw_rrtm(:, :, 2, inu) + tr_seri(:, :, itr) * zdm(:, :) * alpha_abs_CIDUST_16bands(inu, spinsol)
    7271        !--no aerosol at all
    73         tau_aero_lw_rrtm(:,:,1,inu) = tau_aero_lw_rrtm(:,:,1,inu) + 0.0
    74         !
     72        tau_aero_lw_rrtm(:, :, 1, inu) = tau_aero_lw_rrtm(:, :, 1, inu) + 0.0
     73
    7574      ENDDO
    76     !
     75
    7776    ENDDO
    78     !
     77
    7978    !--avoid very small values
    80     tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm,1.e-15)
    81     !
     79    tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm, 1.e-15)
     80
    8281  ELSE
    8382    !--default value
    8483    tau_aero_lw_rrtm = 1.e-15
    8584  ENDIF
    86   !
     85
    8786END SUBROUTINE SPLAEROPT_LW_RRTM

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/splaerosol_optic_rrtm.f90

    r5098 r5099  
    11! $Id: splaerosol_optic_rrtm.F90 2644 2016-10-02 16:55:08Z oboucher $
    2 !
    3 SUBROUTINE splaerosol_optic_rrtm( ok_alw, pplay, paprs, t_seri, rhcl, &
    4      tr_seri, mass_solu_aero, mass_solu_aero_pi, &
    5      tau_aero, piz_aero, cg_aero, &
    6      tausum_aero, tau3d_aero )
     2
     3SUBROUTINE splaerosol_optic_rrtm(ok_alw, pplay, paprs, t_seri, rhcl, &
     4        tr_seri, mass_solu_aero, mass_solu_aero_pi, &
     5        tau_aero, piz_aero, cg_aero, &
     6        tausum_aero, tau3d_aero)
    77
    88  ! This routine will :
    99  ! 1) recevie the aerosols(already read and interpolated) corresponding to flag_aerosol
    1010  ! 2) calculate the optical properties for the aerosols
    11   !
    1211
    1312  USE dimphy
    1413  USE aero_mod
    15   USE infotrac_phy, ONLY: nbtr, nqtot, tracers
    16   USE YOMCST, ONLY: RD, RG
     14  USE infotrac_phy, ONLY : nbtr, nqtot, tracers
     15  USE lmdz_yomcst, ONLY : RD, RG
    1716
    1817  IMPLICIT NONE
    … …  
    2423  !****************************************************************************************
    2524  LOGICAL, INTENT(IN) :: ok_alw                      ! Apply aerosol LW effect or not
    26   REAL, DIMENSION(klon,klev), INTENT(IN)  :: pplay
    27   REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
    28   REAL, DIMENSION(klon,klev), INTENT(IN)  :: t_seri
    29   REAL, DIMENSION(klon,klev), INTENT(IN)  :: rhcl   ! humidite relative ciel clair
    30   REAL, DIMENSION(klon,klev,nbtr), INTENT(IN) :: tr_seri ! concentration tracer
     25  REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay
     26  REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs
     27  REAL, DIMENSION(klon, klev), INTENT(IN) :: t_seri
     28  REAL, DIMENSION(klon, klev), INTENT(IN) :: rhcl   ! humidite relative ciel clair
     29  REAL, DIMENSION(klon, klev, nbtr), INTENT(IN) :: tr_seri ! concentration tracer
    3130
    3231  ! Output arguments
    3332  !****************************************************************************************
    34   REAL, DIMENSION(klon,klev), INTENT(OUT)    :: mass_solu_aero    ! Total mass for all soluble aerosols
    35   REAL, DIMENSION(klon,klev), INTENT(OUT)    :: mass_solu_aero_pi !     -"-     preindustrial values
    36   REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: tau_aero    ! Aerosol optical thickness
    37   REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: piz_aero    ! Single scattering albedo aerosol
    38   REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: cg_aero     ! asymmetry parameter aerosol
    39   REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)      :: tausum_aero
    40   REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT) :: tau3d_aero
     33  REAL, DIMENSION(klon, klev), INTENT(OUT) :: mass_solu_aero    ! Total mass for all soluble aerosols
     34  REAL, DIMENSION(klon, klev), INTENT(OUT) :: mass_solu_aero_pi !     -"-     preindustrial values
     35  REAL, DIMENSION(klon, klev, 2, NSW), INTENT(OUT) :: tau_aero    ! Aerosol optical thickness
     36  REAL, DIMENSION(klon, klev, 2, NSW), INTENT(OUT) :: piz_aero    ! Single scattering albedo aerosol
     37  REAL, DIMENSION(klon, klev, 2, NSW), INTENT(OUT) :: cg_aero     ! asymmetry parameter aerosol
     38  REAL, DIMENSION(klon, nwave, naero_tot), INTENT(OUT) :: tausum_aero
     39  REAL, DIMENSION(klon, klev, nwave, naero_tot), INTENT(OUT) :: tau3d_aero
    4140
    4241  INTEGER i, k, iq, itr
    43   REAL, DIMENSION(klon,klev) :: zdm, zdh
     42  REAL, DIMENSION(klon, klev) :: zdm, zdh
    4443  REAL zrho, pdel
    45   !
     44
    4645  ! Calculate the total mass of all soluble accumulation mode aerosols
    4746  ! to be revisited for AR6
    48   !
    49   mass_solu_aero(:,:)    = 0.0
    50   mass_solu_aero_pi(:,:) = 0.0
    51   !
     47
     48  mass_solu_aero(:, :) = 0.0
     49  mass_solu_aero_pi(:, :) = 0.0
     50
    5251  itr = 0
    5352  DO iq = 1, nqtot
    5453    IF(.NOT.tracers(iq)%isInPhysics) CYCLE
    55     itr = itr+1
     54    itr = itr + 1
    5655    IF(tracers(iq)%name/='FINE') THEN
    57       mass_solu_aero(:,:)    = tr_seri(:,:,itr)
    58       mass_solu_aero_pi(:,:) = tr_seri(:,:,itr)
     56      mass_solu_aero(:, :) = tr_seri(:, :, itr)
     57      mass_solu_aero_pi(:, :) = tr_seri(:, :, itr)
    5958    ENDIF
    6059  ENDDO
    … …  
    6362  DO k = 1, klev
    6463    DO i = 1, klon
    65       pdel=paprs(i,k)-paprs(i,k+1)
    66       zrho=pplay(i,k)/t_seri(i,k)/RD             ! kg/m3
    67       zdh(i,k)=pdel/(RG*zrho)                    ! m
    68       zdm(i,k)=pdel/RG                           ! kg/m2
     64      pdel = paprs(i, k) - paprs(i, k + 1)
     65      zrho = pplay(i, k) / t_seri(i, k) / RD             ! kg/m3
     66      zdh(i, k) = pdel / (RG * zrho)                    ! m
     67      zdm(i, k) = pdel / RG                           ! kg/m2
    6968    ENDDO
    7069  ENDDO
    7170
    72 !--new aerosol properties
    73 ! aeropt_6bands for rrtm
    74   CALL splaeropt_6bands_rrtm(       &
    75        zdm, tr_seri, rhcl,          &
    76        tau_aero, piz_aero, cg_aero )
     71  !--new aerosol properties
     72  ! aeropt_6bands for rrtm
     73  CALL splaeropt_6bands_rrtm(&
     74          zdm, tr_seri, rhcl, &
     75          tau_aero, piz_aero, cg_aero)
    7776
    78 ! aeropt_5wv only for validation and diagnostics
    79   CALL splaeropt_5wv_rrtm(          &
    80        zdm, zdh, tr_seri, rhcl,     &
    81        tausum_aero, tau3d_aero )
     77  ! aeropt_5wv only for validation and diagnostics
     78  CALL splaeropt_5wv_rrtm(&
     79          zdm, zdh, tr_seri, rhcl, &
     80          tausum_aero, tau3d_aero)
    8281
    83 ! LW optical properties for tropospheric aerosols
    84   CALL splaeropt_lw_rrtm(ok_alw,zdm,tr_seri)
     82  ! LW optical properties for tropospheric aerosols
     83  CALL splaeropt_lw_rrtm(ok_alw, zdm, tr_seri)
    8584
    8685END SUBROUTINE splaerosol_optic_rrtm

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/tiedqneg.f90

    r5098 r5099  
    1       SUBROUTINE tiedqneg (pres_h,q,d_q)
    2 c
    3       USE dimphy
    4       IMPLICIT none
    5 c======================================================================
    6 c Auteur(s): CG (LGGE/CNRS) date: 19950201
    7 c            O. Boucher (LOA/CNRS) date 19961125
    8 c Objet:  Correction eventuelle des valeurs negatives d'humidite
    9 c induites par le schema de convection de Tiedke
    10 c======================================================================
    11 c Arguments:
    12 c pres_h--input-R-la valeur de la pression aux interfaces
    13 c q-------input-R-quantite de traceur
    14 c d_q-----input-output-R-increment du traceur
    15 c======================================================================
    16 c
    17       INCLUDE "dimensions.h"
    18 c      INCLUDE "dimphy.h"
    19       REAL pres_h(klon,klev+1)
    20       REAL q(klon,klev)
    21       REAL d_q(klon,klev)
    22       INTEGER nb_neg
    23       INTEGER i, l
    24 c
    25       REAL qmin
    26       PARAMETER (qmin=0.0)
    27 c
    28       DO l = klev,2,-1
    29         nb_neg = 0
    30         DO i = 1,klon
    31           IF (q(i,l)+d_q(i,l)<qmin) THEN
    32           nb_neg = nb_neg + 1
    33           d_q(i,l-1) = d_q(i,l-1) + (q(i,l)+d_q(i,l)-qmin)
    34      .       *(pres_h(i,l)-pres_h(i,l+1))/(pres_h(i,l-1)-pres_h(i,l))
    35             d_q(i,l) = qmin - q(i,l)
    36           ENDIF
    37         ENDDO
    38 c        IF (nb_neg.NE.0) THEN
    39 c        PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives'
    40 c        ENDIF
    41       ENDDO
    42 c
    43       DO l = 1, klev-1
    44         nb_neg = 0
    45         DO i = 1,klon
    46           IF (q(i,l)+d_q(i,l)<qmin) THEN
    47           nb_neg = nb_neg + 1
    48           d_q(i,l+1) = d_q(i,l+1) + (q(i,l)+d_q(i,l)-qmin)
    49      .      *(pres_h(i,l)-pres_h(i,l+1))/(pres_h(i,l+1)-pres_h(i,l+2))
    50           d_q(i,l) = qmin - q(i,l)
    51           ENDIF
    52         ENDDO
    53 c        IF (nb_neg.NE.0) THEN
    54 c        PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives'
    55 c        ENDIF
    56       ENDDO
    57 c
    58       l = klev
    59       DO i = 1,klon
    60         IF (q(i,l)+d_q(i,l)<qmin) THEN
    61           d_q(i,l) = qmin - q(i,l)
    62         ENDIF
    63       ENDDO
    64 c
    65       RETURN
    66       END
     1SUBROUTINE tiedqneg (pres_h, q, d_q)
     2
     3  USE dimphy
     4  IMPLICIT none
     5  !======================================================================
     6  ! Auteur(s): CG (LGGE/CNRS) date: 19950201
     7  ! O. Boucher (LOA/CNRS) date 19961125
     8  ! Objet:  Correction eventuelle des valeurs negatives d'humidite
     9  ! induites par le schema de convection de Tiedke
     10  !======================================================================
     11  ! Arguments:
     12  ! pres_h--input-R-la valeur de la pression aux interfaces
     13  ! q-------input-R-quantite de traceur
     14  ! d_q-----input-output-R-increment du traceur
     15  !======================================================================
     16
     17  INCLUDE "dimensions.h"
     18  ! INCLUDE "dimphy.h"
     19  REAL :: pres_h(klon, klev + 1)
     20  REAL :: q(klon, klev)
     21  REAL :: d_q(klon, klev)
     22  INTEGER :: nb_neg
     23  INTEGER :: i, l
     24
     25  REAL :: qmin
     26  PARAMETER (qmin = 0.0)
     27
     28  DO l = klev, 2, -1
     29    nb_neg = 0
     30    DO i = 1, klon
     31      IF (q(i, l) + d_q(i, l)<qmin) THEN
     32        nb_neg = nb_neg + 1
     33        d_q(i, l - 1) = d_q(i, l - 1) + (q(i, l) + d_q(i, l) - qmin) &
     34                * (pres_h(i, l) - pres_h(i, l + 1)) / (pres_h(i, l - 1) - pres_h(i, l))
     35        d_q(i, l) = qmin - q(i, l)
     36      ENDIF
     37    ENDDO
     38    ! IF (nb_neg.NE.0) THEN
     39    ! PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives'
     40    ! ENDIF
     41  ENDDO
     42
     43  DO l = 1, klev - 1
     44    nb_neg = 0
     45    DO i = 1, klon
     46      IF (q(i, l) + d_q(i, l)<qmin) THEN
     47        nb_neg = nb_neg + 1
     48        d_q(i, l + 1) = d_q(i, l + 1) + (q(i, l) + d_q(i, l) - qmin) &
     49                * (pres_h(i, l) - pres_h(i, l + 1)) / (pres_h(i, l + 1) - pres_h(i, l + 2))
     50        d_q(i, l) = qmin - q(i, l)
     51      ENDIF
     52    ENDDO
     53    ! IF (nb_neg.NE.0) THEN
     54    ! PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives'
     55    ! ENDIF
     56  ENDDO
     57
     58  l = klev
     59  DO i = 1, klon
     60    IF (q(i, l) + d_q(i, l)<qmin) THEN
     61      d_q(i, l) = qmin - q(i, l)
     62    ENDIF
     63  ENDDO
     64
     65  RETURN
     66END SUBROUTINE tiedqneg
Note: See TracChangeset for help on using the changeset viewer.