Ignore:
Timestamp:
Jan 12, 2022, 10:54:09 PM (3 years ago)
Author:
dcugnet
Message:

Most of the changes are intended to help to eventually remove the constraints about the tracers assumptions, in particular water tracers.

  • Remove index tables itr_indice and niadv, replaced by tracers(:)%isAdvected and tracers(:)%isH2OFamily. Most of the loops are now from 1 to nqtot:
    • DO iq=nqo+1,nqtot loops are replaced with: DO iq=1,nqtot

IF(tracers(iq)%isH2Ofamily) CYCLE

  • DO it=1,nbtr; iq=niadv(it+nqo)

and DO it=1,nqtottr; iq=itr_indice(it) loops are replaced with:

it = 0
DO iq = 1, nqtot

IF(.NOT.tracers(iq)%isAdvected .OR. tracers(iq)%isH2Ofamily) CYCLE
it = it+1

  • Move some StratAer? related code from infotrac to infotrac_phy
  • Remove "nqperes" variable:

DO iq=1,nqpere loops are replaced with:
DO iq=1,nqtot

IF(tracers(iq)%parent/='air') CYCLE

  • Cosmetic changes (justification, SELECT CASE instead of multiple IF...) mostly in advtrac* routines.
Location:
LMDZ6/trunk/libf/phylmd
Files:
15 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/Dust/phys_output_write_spl_mod.F90

    r3805 r4056  
    381381    USE pbl_surface_mod, ONLY: snow
    382382    USE indice_sol_mod, ONLY: nbsrf
    383     USE infotrac, ONLY: nqtot, nqo, nbtr, type_trac
     383    USE infotrac, ONLY: nqtot, nbtr, type_trac
    384384    USE geometry_mod, ONLY: cell_area
    385385    USE surface_data, ONLY: type_ocean, version_ocean, ok_veget, landice_opt
    … …  
    430430    INTEGER, PARAMETER :: jjmp1=jjm+1-1/jjm
    431431    INTEGER :: itau_w
    432     INTEGER :: i, iinit, iinitend=1, iff, iq, nsrf, k, ll, naero
     432    INTEGER :: i, iinit, iinitend=1, iff, iq, itr, nsrf, k, ll, naero
    433433    REAL, DIMENSION (klon) :: zx_tmp_fi2d
    434434    REAL, DIMENSION (klon,klev) :: zx_tmp_fi3d, zpt_conv
    … …  
    16101610#endif
    16111611!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1612        IF (nqtot.GE.nqo+1) THEN
    1613          !AS: type_trac = 'lmdz' par defaut dans libf/dyn3d/conf_gcm.F90
    1614          !Changé par inca, repr(obus), coag(ulation), co2i(nteractif), PAS par SPLA
    1615          !Cet "if" est donc inutile : IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
    1616            DO iq=nqo+1,nqtot
    1617              CALL histwrite_phy(o_trac(iq-nqo), tr_seri(:,:,iq-nqo))
    1618              CALL histwrite_phy(o_dtr_vdf(iq-nqo),d_tr_cl(:,:,iq-nqo))
    1619              CALL histwrite_phy(o_dtr_the(iq-nqo),d_tr_th(:,:,iq-nqo))
    1620              CALL histwrite_phy(o_dtr_con(iq-nqo),d_tr_cv(:,:,iq-nqo))
    1621              CALL histwrite_phy(o_dtr_lessi_impa(iq-nqo),d_tr_lessi_impa(:,:,iq-nqo))
    1622              CALL histwrite_phy(o_dtr_lessi_nucl(iq-nqo),d_tr_lessi_nucl(:,:,iq-nqo))
    1623              CALL histwrite_phy(o_dtr_insc(iq-nqo),d_tr_insc(:,:,iq-nqo))
    1624              CALL histwrite_phy(o_dtr_bcscav(iq-nqo),d_tr_bcscav(:,:,iq-nqo))
    1625              CALL histwrite_phy(o_dtr_evapls(iq-nqo),d_tr_evapls(:,:,iq-nqo))
    1626              CALL histwrite_phy(o_dtr_ls(iq-nqo),d_tr_ls(:,:,iq-nqo))
    1627 !            CALL histwrite_phy(o_dtr_dyn(iq-nqo),d_tr_dyn(:,:,iq-nqo))
    1628 !            CALL histwrite_phy(o_dtr_cl(iq-nqo),d_tr_cl(:,:,iq-nqo))
    1629              CALL histwrite_phy(o_dtr_trsp(iq-nqo),d_tr_trsp(:,:,iq-nqo))
    1630              CALL histwrite_phy(o_dtr_sscav(iq-nqo),d_tr_sscav(:,:,iq-nqo))
    1631              CALL histwrite_phy(o_dtr_sat(iq-nqo),d_tr_sat(:,:,iq-nqo))
    1632              CALL histwrite_phy(o_dtr_uscav(iq-nqo),d_tr_uscav(:,:,iq-nqo))
     1612           itr = 0
     1613           DO iq = 1, nqtot
     1614             IF(tracers(iq)%isH2Ofamily) CYCLE
     1615             itr = itr+1
     1616             CALL histwrite_phy(o_trac(itr), tr_seri(:,:,itr))
     1617             CALL histwrite_phy(o_dtr_vdf(itr),d_tr_cl(:,:,itr))
     1618             CALL histwrite_phy(o_dtr_the(itr),d_tr_th(:,:,itr))
     1619             CALL histwrite_phy(o_dtr_con(itr),d_tr_cv(:,:,itr))
     1620             CALL histwrite_phy(o_dtr_lessi_impa(itr),d_tr_lessi_impa(:,:,itr))
     1621             CALL histwrite_phy(o_dtr_lessi_nucl(itr),d_tr_lessi_nucl(:,:,itr))
     1622             CALL histwrite_phy(o_dtr_insc(itr),d_tr_insc(:,:,itr))
     1623             CALL histwrite_phy(o_dtr_bcscav(itr),d_tr_bcscav(:,:,itr))
     1624             CALL histwrite_phy(o_dtr_evapls(itr),d_tr_evapls(:,:,itr))
     1625             CALL histwrite_phy(o_dtr_ls(itr),d_tr_ls(:,:,itr))
     1626!            CALL histwrite_phy(o_dtr_dyn(itr),d_tr_dyn(:,:,itr))
     1627!            CALL histwrite_phy(o_dtr_cl(itr),d_tr_cl(:,:,itr))
     1628             CALL histwrite_phy(o_dtr_trsp(itr),d_tr_trsp(:,:,itr))
     1629             CALL histwrite_phy(o_dtr_sscav(itr),d_tr_sscav(:,:,itr))
     1630             CALL histwrite_phy(o_dtr_sat(itr),d_tr_sat(:,:,itr))
     1631             CALL histwrite_phy(o_dtr_uscav(itr),d_tr_uscav(:,:,itr))
    16331632             zx_tmp_fi2d=0.
    16341633             IF (vars_defined) THEN
    16351634                DO k=1,klev
    1636                    zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*tr_seri(:,k,iq-nqo)
     1635                   zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*tr_seri(:,k,itr)
    16371636                ENDDO
    16381637             ENDIF
    1639              CALL histwrite_phy(o_trac_cum(iq-nqo), zx_tmp_fi2d)
     1638             CALL histwrite_phy(o_trac_cum(itr), zx_tmp_fi2d)
    16401639           ENDDO
    1641          !ENDIF
    1642        ENDIF
    16431640
    16441641       IF (.NOT.vars_defined) THEN

  • LMDZ6/trunk/libf/phylmd/Dust/phytracr_spl_mod.F90

    r4046 r4056  
    11041104      REAL, intent(in) ::  rlon(klon)       ! longitudes pour chaque point
    11051105!
    1106       INTEGER i, k, it, j, ig
     1106      INTEGER i, k, iq, itr, j, ig
    11071107!
    11081108! DEFINITION OF DIAGNOSTIC VARIABLES
    … …  
    12601260
    12611261#ifdef IOPHYS_DUST
    1262       do it=1,nbtr
    1263          write(str2,'(i2.2)') it
    1264          call iophys_ecrit('TRA'//str2,klev,'SOURCE','',tr_seri(:,:,it))
     1262      itr = 0
     1263      DO iq = 1, nqtot
     1264         IF(tracers(iq)%isH2Ofamily) CYCLE
     1265         itr = itr+1
     1266         write(str2,'(i2.2)') itr
     1267         call iophys_ecrit('TRA'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
    12651268      enddo
    12661269#endif
    … …  
    14141417        id_codu=-1
    14151418        id_scdu=-1
    1416        !print *,nbtr
    1417        do it=1,nbtr
    1418         print *, it, tracers(it+nqo)%name
    1419         SELECT CASE(tracers(it+nqo)%name)
    1420           CASE('PREC'); id_prec=it
    1421           CASE('FINE'); id_fine=it
    1422           CASE('COSS'); id_coss=it
    1423           CASE('CODU'); id_codu=it
    1424           CASE('SCDU'); id_scdu=it
    1425         END SELECT
    1426        enddo
    1427        ! check consistency with dust emission scheme:
    1428        if (ok_chimeredust) then
     1419        itr = 0
     1420        do iq=1,nqtot
     1421          IF(tracers(iq)%isH2Ofamily) CYCLE
     1422          itr = itr+1
     1423          print *, itr, TRIM(tracers(iq)%name)
     1424          SELECT CASE(tracers(iq)%name)
     1425            CASE('PREC'); id_prec=itr
     1426            CASE('FINE'); id_fine=itr
     1427            CASE('COSS'); id_coss=itr
     1428            CASE('CODU'); id_codu=itr
     1429            CASE('SCDU'); id_scdu=itr
     1430          END SELECT
     1431        enddo
     1432        ! check consistency with dust emission scheme:
     1433        if (ok_chimeredust) then
    14291434          if (.not.( id_scdu>0 .and. id_codu>0 .and. id_fine>0)) then
    14301435             call abort_gcm('phytracr_mod', 'pb in ok_chimdust 0',1)
    14311436          endif
    1432        else
     1437        else
    14331438          if (id_scdu>0) then
    14341439       call abort_gcm('phytracr_mod', 'pb in ok_chimdust 1 SCDU',1)
    … …  
    15601565! JE before put in zero
    15611566      IF (lminmax) THEN
    1562         DO it=1,nbtr
    1563         CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan init phytracr')
    1564         ENDDO       
    1565         DO it=1,nbtr
    1566         CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'minmax init phytracr')
     1567        DO itr=1,nbtr
     1568        CALL checknanqfi(tr_seri(:,:,itr),qmin,qmax,'nan init phytracr')
     1569        ENDDO
     1570        DO itr=1,nbtr
     1571        CALL minmaxqfi2(tr_seri(:,:,itr),qmin,qmax,'minmax init phytracr')
    15671572        ENDDO
    15681573        CALL minmaxsource(source_tr,qmin,qmax,'maxsource init phytracr')

  • LMDZ6/trunk/libf/phylmd/Dust/splaeropt_5wv_rrtm.F90

    r4046 r4056  
    99  USE DIMPHY
    1010  USE aero_mod
    11   USE infotrac_phy
     11  USE infotrac_phy, ONLY: nqtot, nbtr, tracers
    1212  USE phys_local_var_mod, ONLY: od550aer,od865aer,ec550aer,od550lt1aer
    1313  !
    … …  
    3434  LOGICAL :: soluble
    3535 
    36   INTEGER :: i, k, m, itr, irh, aerindex
     36  INTEGER :: i, k, m, iq, itr, irh, aerindex
    3737  INTEGER :: spsol, spinsol, la
    3838  INTEGER :: RH_num(klon,klev)
    … …  
    112112  ENDDO
    113113
    114   DO itr=1,nbtr    !--loop over tracers 
    115     SELECT CASE(tracers(itr+nqo)%name)
     114  itr = 0
     115  DO iq = 1, nqtot
     116    IF(tracers(iq)%isH2Ofamily) CYCLE
     117    itr = itr+1
     118    SELECT CASE(tracers(iq)%name)
    116119      CASE('PREC'); CYCLE                                  !--precursor
    117120      CASE('FINE'); soluble=.TRUE.;  spsol=1; aerindex=1   !--fine mode accumulation mode
    … …  
    119122      CASE('CODU'); soluble=.FALSE.; spsol=1; aerindex=3   !--coarse mode dust
    120123      CASE('SCDU'); soluble=.FALSE.; spsol=2; aerindex=4   !--super coarse mode dust
    121       CASE DEFAULT; CALL abort_physic(modname,'I cannot do aerosol optics for '//tracers(itr+nqo)%name,1)
     124      CASE DEFAULT; CALL abort_physic(modname,'I cannot do aerosol optics for '//tracers(iq)%name,1)
    122125    END SELECT
    123126

  • LMDZ6/trunk/libf/phylmd/Dust/splaeropt_6bands_rrtm.F90

    r4046 r4056  
    88  USE dimphy
    99  USE aero_mod
    10   USE infotrac_phy
     10  USE infotrac_phy, ONLY: nqtot, nbtr, tracers
    1111  USE phys_local_var_mod, ONLY: abs550aer
    1212
    … …  
    3535  !
    3636  LOGICAL :: soluble
    37   INTEGER :: i, k, irh, itr, inu
     37  INTEGER :: i, k, irh, iq, itr, inu
    3838  INTEGER :: aerindex, spsol, spinsol
    3939  INTEGER :: RH_num(klon,klev)
    … …  
    165165  cg_ae(:,:,:,:)=0.
    166166   
    167   DO itr=1,nbtr    !--loop over tracers 
    168     SELECT CASE(tracers(itr+nqo)%name)
     167  itr = 0
     168  DO iq = 1, nqtot
     169    IF(tracers(iq)%isH2Ofamily) CYCLE
     170    itr = itr+1
     171    SELECT CASE(tracers(iq)%name)
    169172      CASE('PREC'); CYCLE                                  !--precursor
    170173      CASE('FINE'); soluble=.TRUE.;  spsol=1; aerindex=1   !--fine mode accumulation mode
    … …  
    172175      CASE('CODU'); soluble=.FALSE.; spsol=1; aerindex=3   !--coarse mode dust
    173176      CASE('SCDU'); soluble=.FALSE.; spsol=2; aerindex=4   !--super coarse mode dust
    174       CASE DEFAULT; CALL abort_physic(modname,'I cannot do aerosol optics for '//tracers(itr+nqo)%name,1)
     177      CASE DEFAULT; CALL abort_physic(modname,'I cannot do aerosol optics for '//tracers(iq)%name,1)
    175178    END SELECT
    176179

  • LMDZ6/trunk/libf/phylmd/Dust/splaeropt_lw_rrtm.F90

    r4046 r4056  
    1010  USE dimphy
    1111  USE aero_mod
    12   USE infotrac_phy
     12  USE infotrac_phy, ONLY: nqtot, nbtr, tracers
    1313  USE phys_state_var_mod, ONLY : tau_aero_lw_rrtm
    1414  USE YOERAD, ONLY : NLW
    … …  
    3030  INTEGER, PARAMETER :: naero=naero_soluble+naero_insoluble
    3131  !
    32   INTEGER inu, itr, spinsol
     32  INTEGER inu, itr, iq, spinsol
    3333  CHARACTER*20 modname
    3434  !
    … …  
    5454    tau_aero_lw_rrtm = 0.0
    5555    !
    56     DO itr=1,nbtr
    57       SELECT CASE(tracers(itr+nqo)%name)
    58         CASE('PREC','FINE''COSS'); CYCLE                   !--precursor or fine/coarde accumulation mode
     56   
     57    itr = 0
     58    DO iq = 1, nqtot
     59      IF(tracers(iq)%isH2Ofamily) CYCLE
     60      itr = itr+1
     61      SELECT CASE(tracers(iq)%name)
     62        CASE('PREC','FINE','COSS'); CYCLE                  !--precursor or fine/coarde accumulation mode
    5963        CASE('CODU'); spinsol=1                            !--coarse mode dust
    6064        CASE('SCDU'); spinsol=2                            !--super coarse mode dust
    61         CASE DEFAULT; CALL abort_physic(modname,'I cannot do aerosol optics for '//tracers(itr+nqo)%name,1)
     65        CASE DEFAULT; CALL abort_physic(modname,'I cannot do aerosol optics for '//tracers(iq)%name,1)
    6266      END SELECT
    6367      !

  • LMDZ6/trunk/libf/phylmd/Dust/splaerosol_optic_rrtm.F90

    r4046 r4056  
    1313  USE dimphy
    1414  USE aero_mod
    15   USE infotrac_phy
     15  USE infotrac_phy, ONLY: nbtr, nqtot, tracers
    1616  USE YOMCST, ONLY: RD, RG
    1717
    … …  
    4040  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT)  :: tau3d_aero
    4141
    42   INTEGER i, k, itr
     42  INTEGER i, k, iq, itr
    4343  REAL, DIMENSION(klon,klev) :: zdm, zdh
    4444  REAL zrho, pdel
    … …  
    5050  mass_solu_aero_pi(:,:) = 0.0
    5151  !
    52   DO itr=1,nbtr
    53     IF (tracers(itr+nqo)%name=='FINE') THEN
     52  itr = 0
     53  DO iq = 1, nqtot
     54    IF(tracers(iq)%isH2Ofamily) CYCLE
     55    itr = itr+1
     56    IF(tracers(iq)%name/='FINE') THEN
    5457      mass_solu_aero(:,:)    = tr_seri(:,:,itr)
    5558      mass_solu_aero_pi(:,:) = tr_seri(:,:,itr)

  • LMDZ6/trunk/libf/phylmd/infotrac_phy.F90

    r4052 r4056  
    2626!$OMP THREADPRIVATE(nqtottr)
    2727
    28 ! ThL : number of CO2 tracers                   ModThL
     28! ThL : number of CO2 tracers   ModThL
    2929  INTEGER, SAVE :: nqCO2
    3030!$OMP THREADPRIVATE(nqCO2)
    3131
    3232#ifdef CPP_StratAer
    33 ! nbtr_bin: number of aerosol bins for StratAer model
    34 ! nbtr_sulgas: number of sulfur gases for StratAer model
    35   INTEGER, SAVE :: nbtr_bin, nbtr_sulgas
    36 !$OMP THREADPRIVATE(nbtr_bin,nbtr_sulgas)
    37   INTEGER, SAVE :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat
    38 !$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat)
     33  !=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB)
     34  INTEGER, SAVE ::  nbtr_bin, nbtr_sulgas         !--- number of aerosols bins and sulfur gases for StratAer model
     35!$OMP THREADPRIVATE(nbtr_bin, nbtr_sulgas)
     36  INTEGER, SAVE ::  id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat
     37!$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat)
    3938#endif
    40 
    41 ! CRisi: nb traceurs pères= directement advectés par l'air
    42   INTEGER, SAVE :: nqperes
    43 !$OMP THREADPRIVATE(nqperes)
    4439
    4540! Tracers parameters
    4641  TYPE(trac_type), TARGET, ALLOCATABLE, SAVE :: tracers(:)
    4742!$OMP THREADPRIVATE(tracers)
    48 
    49 ! niadv : vector keeping the coorspondance between all tracers(nqtot) treated in the
    50 !         dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code.
    51   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: niadv ! equivalent dyn / physique
    52 !$OMP THREADPRIVATE(niadv)
    5343
    5444! conv_flg(it)=0 : convection desactivated for tracer number it
    … …  
    8575!$OMP THREADPRIVATE(niso,ntraceurs_zone,ntraciso)
    8676
    87     INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  itr_indice ! numéro iq entre 1 et nqtot qui correspond au traceur itr entre 1 et nqtottr
    88 !$OMP THREADPRIVATE(itr_indice)
    89  
    9077CONTAINS
    9178
    9279  SUBROUTINE init_infotrac_phy(nqtot_,nqo_,nbtr_,nqtottr_,nqCO2_,tracers_,type_trac_,&
    93                                niadv_,conv_flg_,pbl_flg_,solsym_,&
     80                               conv_flg_,pbl_flg_,solsym_,&
    9481                               ok_isotopes_,ok_iso_verif_,ok_isotrac_,&
    9582                               ok_init_iso_,niso_possibles_,tnat_,&
    9683                               alpha_ideal_,use_iso_,iqiso_,iso_indnum_,&
    9784                               indnum_fn_num_,index_trac_,&
    98                                niso_,ntraceurs_zone_,ntraciso_,itr_indice_&
    99 #ifdef CPP_StratAer
    100                                ,nbtr_bin_,nbtr_sulgas_&
    101                                ,id_OCS_strat_,id_SO2_strat_,id_H2SO4_strat_,id_BIN01_strat_&
    102 #endif
    103                                )
     85                               niso_,ntraceurs_zone_,ntraciso_)
    10486
    10587    ! transfer information on tracers from dynamics to physics
    … …  
    11294    INTEGER,INTENT(IN) :: nqtottr_
    11395    INTEGER,INTENT(IN) :: nqCO2_
    114 #ifdef CPP_StratAer
    115     INTEGER,INTENT(IN) :: nbtr_bin_
    116     INTEGER,INTENT(IN) :: nbtr_sulgas_
    117     INTEGER,INTENT(IN) :: id_OCS_strat_
    118     INTEGER,INTENT(IN) :: id_SO2_strat_
    119     INTEGER,INTENT(IN) :: id_H2SO4_strat_
    120     INTEGER,INTENT(IN) :: id_BIN01_strat_
    121 #endif
    12296    TYPE(trac_type), INTENT(IN) :: tracers_(nqtot_) ! tracers descriptors
    12397    CHARACTER(len=*),INTENT(IN) :: type_trac_
    124     INTEGER,INTENT(IN) :: niadv_ (nqtot_) ! equivalent dyn / physique
    12598    INTEGER,INTENT(IN) :: conv_flg_(nbtr_)
    12699    INTEGER,INTENT(IN) :: pbl_flg_(nbtr_)
    … …  
    142115    INTEGER,INTENT(IN) :: ntraceurs_zone_
    143116    INTEGER,INTENT(IN) :: ntraciso_
    144     INTEGER,INTENT(IN) :: itr_indice_(nqtottr_)
    145 
    146     CHARACTER(LEN=30) :: modname="init_infotrac_phy"
     117
     118    INTEGER :: iq, itr
     119    CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
     120    CHARACTER(LEN=maxlen) :: modname="init_infotrac_phy"
    147121
    148122    nqtot=nqtot_
    … …  
    153127    ALLOCATE(tracers(nqtot)); tracers(:) = tracers_(:)
    154128#ifdef CPP_StratAer
    155     nbtr_bin=nbtr_bin_
    156     nbtr_sulgas=nbtr_sulgas_
    157     id_OCS_strat=id_OCS_strat_
    158     id_SO2_strat=id_SO2_strat_
    159     id_H2SO4_strat=id_H2SO4_strat_
    160     id_BIN01_strat=id_BIN01_strat_
     129    IF (type_trac == 'coag') THEN
     130      nbtr_bin    = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)])
     131      nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)])
     132      tnames = PACK(tracers(:)%name, MASK=.NOT.tracers(:)%isH2Ofamily)
     133      id_BIN01_strat = strIdx(tnames, 'BIN01'   )
     134      id_OCS_strat   = strIdx(tnames, 'GASOSC'  )
     135      id_SO2_strat   = strIdx(tnames, 'GASSO2'  )
     136      id_H2SO4_strat = strIdx(tnames, 'GASH2SO4')
     137      id_TEST_strat  = strIdx(tnames, 'GASTEST' )
     138      WRITE(lunout,*)'nbtr_bin       =', nbtr_bin
     139      WRITE(lunout,*)'nbtr_sulgas    =', nbtr_sulgas
     140      WRITE(lunout,*)'id_BIN01_strat =', id_BIN01_strat
     141      WRITE(lunout,*)'id_OCS_strat   =',   id_OCS_strat
     142      WRITE(lunout,*)'id_SO2_strat   =',   id_SO2_strat
     143      WRITE(lunout,*)'id_H2SO4_strat =', id_H2SO4_strat
     144      WRITE(lunout,*)'id_TEST_strat  =',  id_TEST_strat
     145    END IF
    161146#endif
    162147    type_trac = type_trac_
    163     ALLOCATE(niadv(nqtot))
    164     niadv(:)=niadv_(:)
    165148    ALLOCATE(conv_flg(nbtr))
    166149    conv_flg(:)=conv_flg_(:)
    … …  
    207190    ENDIF ! of IF(ok_isotopes)
    208191
    209     ALLOCATE(itr_indice(nqtottr))
    210     itr_indice(:)=itr_indice_(:)
    211  
     192    WRITE(*,*) 'infotrac_phy 207: nqtottr=',nqtottr
     193    WRITE(*,*) 'ntraciso,niso=',ntraciso,niso
     194#ifdef ISOVERIF
     195    ! DC: the "1" will be replaced by iH2O (H2O isotopes group index)
     196    WRITE(*,*) 'iso_iName=',PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==1)
     197#endif
     198
    212199  END SUBROUTINE init_infotrac_phy
    213200

  • LMDZ6/trunk/libf/phylmd/init_be.F90

    r2351 r4056  
    55
    66  USE dimphy
    7   USE infotrac_phy, ONLY : nbtr
    87  USE indice_sol_mod
    98  USE geometry_mod, ONLY : longitude, latitude

  • LMDZ6/trunk/libf/phylmd/phyetat0.F90

    r4046 r4056  
    2121       ale_wake, ale_bl_stat, ds_ns, dt_ns, delta_sst, delta_sal, ratqs_inter
    2222!FC
    23   USE geometry_mod, ONLY : longitude_deg, latitude_deg
    24   USE iostart, ONLY : close_startphy, get_field, get_var, open_startphy
    25   USE infotrac_phy, only: nbtr, nqo, type_trac, tracers, niadv
    26   USE traclmdz_mod,    ONLY : traclmdz_from_restart
    27   USE carbon_cycle_mod, ONLY : carbon_cycle_tr, carbon_cycle_cpl, co2_send
    28   USE indice_sol_mod, only: nbsrf, is_ter, epsfra, is_lic, is_oce, is_sic
    29   USE ocean_slab_mod, ONLY: nslay, tslab, seaice, tice, ocean_slab_init
     23  USE geometry_mod,     ONLY: longitude_deg, latitude_deg
     24  USE iostart,          ONLY: close_startphy, get_field, get_var, open_startphy
     25  USE infotrac_phy,     ONLY: nqtot, nbtr, type_trac, tracers
     26  USE traclmdz_mod,     ONLY: traclmdz_from_restart
     27  USE carbon_cycle_mod, ONLY: carbon_cycle_tr, carbon_cycle_cpl, co2_send
     28  USE indice_sol_mod,   ONLY: nbsrf, is_ter, epsfra, is_lic, is_oce, is_sic
     29  USE ocean_slab_mod,   ONLY: nslay, tslab, seaice, tice, ocean_slab_init
    3030  USE time_phylmdz_mod, ONLY: init_iteration, pdtphys, itau_phy
    3131#ifdef CPP_XIOS
    … …  
    7575  INTEGER length
    7676  PARAMETER (length=100)
    77   INTEGER it, iiq, isw
     77  INTEGER it, iq, isw
    7878  REAL tab_cntrl(length), tabcntr0(length)
    7979  CHARACTER*7 str7
    … …  
    448448
    449449  IF (type_trac == 'lmdz') THEN
    450      DO it=1, nbtr                                                                 
    451 !!        iiq=niadv(it+2)                                                           ! jyg
    452         iiq=niadv(it+nqo)                                                           ! jyg
    453         found=phyetat0_get(1,trs(:,it),"trs_"//TRIM(tracers(iiq)%name), &
    454                                   "Surf trac"//TRIM(tracers(iiq)%name),0.)
    455      ENDDO
     450     it = 0
     451     DO iq = 1, nqtot
     452        IF(.NOT.tracers(iq)%isAdvected .OR. tracers(iq)%isH2Ofamily) CYCLE
     453        it = it+1
     454        found=phyetat0_get(1,trs(:,it),"trs_"//TRIM(tracers(iq)%name), &
     455                                  "Surf trac"//TRIM(tracers(iq)%name),0.)
     456     END DO
    456457     CALL traclmdz_from_restart(trs)
    457458  ENDIF
    458459
     460!--OB now this is for co2i - ThL: and therefore also for inco
    459461  IF (type_trac == 'co2i' .OR. type_trac == 'inco') THEN
    460462     IF (carbon_cycle_cpl) THEN
    … …  
    598600   CALL get_field(name, field, found)
    599601   IF (.NOT. found) THEN
    600      WRITE(lunout,*) "phyetat0: Le champ <",name,"> est absent"
     602     WRITE(lunout,*) "phyetat0: Le champ <",TRIM(name),"> est absent"
    601603     WRITE(lunout,*) "Depart legerement fausse. Mais je continue"
    602604     field(:,:)=default

  • LMDZ6/trunk/libf/phylmd/phyredem.F90

    r4046 r4056  
    3535  USE iostart, ONLY: open_restartphy, close_restartphy, enddef_restartphy, put_field, put_var
    3636  USE traclmdz_mod, ONLY : traclmdz_to_restart
    37   USE infotrac_phy, ONLY: type_trac, niadv, tracers, nbtr, nqo
     37  USE infotrac_phy, ONLY: type_trac, nqtot, tracers, nbtr
    3838  USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
    3939  USE indice_sol_mod, ONLY: nbsrf, is_oce, is_sic, is_ter, is_lic, epsfra
    … …  
    7070  CHARACTER (len=2) :: str2
    7171  CHARACTER (len=256) :: nam, lnam
    72   INTEGER           :: it, iiq, pass
     72  INTEGER           :: it, iq, pass
    7373
    7474  !======================================================================
    … …  
    326326    IF (type_trac == 'lmdz') THEN
    327327       CALL traclmdz_to_restart(trs)
    328        DO it=1, nbtr
    329 !!        iiq=niadv(it+2)                                                           ! jyg
    330           iiq=niadv(it+nqo)                                                           ! jyg
    331           CALL put_field(pass,"trs_"//tracers(iiq)%name, "", trs(:, it))
     328       it = 0
     329       DO iq = 1, nqtot
     330          IF(.NOT.tracers(iq)%isAdvected .OR. tracers(iq)%isH2Ofamily) CYCLE
     331          it = it+1
     332          CALL put_field(pass,"trs_"//tracers(iq)%name, "", trs(:, it))
    332333       END DO
    333334    END IF
    … …  
    391392
    392393  IMPLICIT NONE
    393   INTEGER, INTENT(IN)            :: pass
     394  INTEGER, INTENT(IN)           :: pass
    394395  CHARACTER(LEN=*),  INTENT(IN) :: nam, lnam
    395396  REAL,              INTENT(IN) :: field(:,:)

  • LMDZ6/trunk/libf/phylmd/phys_output_mod.F90

    r4046 r4056  
    3535    USE iophy
    3636    USE dimphy
    37     USE infotrac_phy, ONLY: nqtot, nqo, niadv, tracers, type_trac
    38     USE strings_mod,  ONLY: maxlen
     37    USE infotrac_phy, ONLY: nqtot, tracers, type_trac, niso, ntraciso, maxlen
    3938    USE ioipsl
    4039    USE phys_cal_mod, only : hour, calend
    … …  
    9695    CHARACTER(LEN=4), DIMENSION(nlevSTD)  :: clevSTD
    9796    REAL, DIMENSION(nlevSTD)              :: rlevSTD
    98     INTEGER                               :: nsrf, k, iq, iiq, iff, i, j, ilev, jq
     97    INTEGER                               :: nsrf, k, iq, iff, i, j, ilev, itr, ixt, iiso, izone
    9998    INTEGER                               :: naero
    10099    LOGICAL                               :: ok_veget
    … …  
    115114    LOGICAL, DIMENSION(nfiles)            :: phys_out_filestations
    116115
    117     CHARACTER(LEN=50) :: outiso
    118     CHARACTER(LEN=20) :: unit
    119116    CHARACTER(LEN=maxlen) :: tnam, lnam, dn
    120117    INTEGER :: flag(nfiles)
    … …  
    122119!!!!!!!!!! stockage dans une region limitee pour chaque fichier !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    123120    !                 entre [phys_out_lonmin,phys_out_lonmax] et [phys_out_latmin,phys_out_latmax]
    124 
    125     LOGICAL, DIMENSION(nfiles), SAVE  :: phys_out_regfkey       = (/ .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., &
    126                                                                      .FALSE., .FALSE., .FALSE., .FALSE., .FALSE. /)
    127     REAL, DIMENSION(nfiles), SAVE     :: phys_out_lonmin        = (/ -180., -180., -180., -180., -180., &
    128                                                                      -180., -180., -180., -180., -180. /)
    129     REAL, DIMENSION(nfiles), SAVE     :: phys_out_lonmax        = (/  180.,  180.,  180.,  180.,  180., &
    130                                                                       180.,  180.,  180.,  180.,  180. /)
    131     REAL, DIMENSION(nfiles), SAVE     :: phys_out_latmin        = (/  -90.,  -90.,  -90.,  -90.,  -90., &
    132                                                                       -90.,  -90.,  -90.,  -90.,  -90. /)
    133     REAL, DIMENSION(nfiles), SAVE     :: phys_out_latmax        = (/   90.,   90.,   90.,   90.,   90., &
    134                                                                        90.,   90.,   90.,   90.,   90. /)
     121    LOGICAL, DIMENSION(nfiles), SAVE :: &
     122      phys_out_regfkey = [.FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE., .FALSE.]
     123    REAL,    DIMENSION(nfiles), SAVE :: &
     124      phys_out_lonmin  = [  -180.,   -180.,   -180.,   -180.,   -180.,   -180.,   -180.,   -180.,   -180.,   -180.], &
     125      phys_out_lonmax  = [   180.,    180.,    180.,    180.,    180.,    180.,    180.,    180.,    180.,    180.], &
     126      phys_out_latmin  = [   -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.,    -90.], &
     127      phys_out_latmax  = [    90.,     90.,     90.,     90.,     90.,     90.,     90.,     90.,     90.,     90.]
    135128    REAL, DIMENSION(klev,2) :: Ahyb_bounds, Bhyb_bounds
    136129    REAL, DIMENSION(klev+1)   :: lev_index
    … …  
    169162    ALLOCATE(o_dtr_dry(nqtot),o_dtr_vdf(nqtot))
    170163
    171     levmax = (/ klev, klev, klev, klev, klev, klev, nlevSTD, nlevSTD, nlevSTD, klev /)
     164    levmax = [klev, klev, klev, klev, klev, klev, nlevSTD, nlevSTD, nlevSTD, klev]
    172165
    173166    phys_out_filenames(1) = 'histmth'
    … …  
    366359    CALL wxios_add_vaxis("bnds", 2, (/1.,2./))
    367360
    368      CALL wxios_add_vaxis("Alt", &
     361    CALL wxios_add_vaxis("Alt", &
    369362            levmax(iff) - levmin(iff) + 1, pseudoalt)
    370363
    371     IF (NSW.EQ.6) THEN
    372 !
    373 !wl1_sun: minimum bound of wavelength (in um)
    374 !
    375       wl1_sun(1)=0.180
    376       wl1_sun(2)=0.250
    377       wl1_sun(3)=0.440
    378       wl1_sun(4)=0.690
    379       wl1_sun(5)=1.190
    380       wl1_sun(6)=2.380
    381 !
    382 !wl2_sun: maximum bound of wavelength (in um)
    383 !
    384       wl2_sun(1)=0.250
    385       wl2_sun(2)=0.440
    386       wl2_sun(3)=0.690
    387       wl2_sun(4)=1.190
    388       wl2_sun(5)=2.380
    389       wl2_sun(6)=4.000
    390 !
    391     ELSE IF(NSW.EQ.2) THEN
    392 !
    393 !wl1_sun: minimum bound of wavelength (in um)
    394 !
    395       wl1_sun(1)=0.250
    396       wl1_sun(2)=0.690
    397 !
    398 !wl2_sun: maximum bound of wavelength (in um)
    399 !
    400       wl2_sun(1)=0.690
    401       wl2_sun(2)=4.000
    402     ENDIF
     364    ! wl1_sun/wl2_sun: minimum/maximum bound of wavelength (in um)
     365    SELECT CASE(NSW)
     366      CASE(6)
     367        wl1_sun(1:6) = [0.180, 0.250, 0.440, 0.690, 1.190, 2.380]
     368        wl2_sun(1:6) = [0.250, 0.440, 0.690, 1.190, 2.380, 4.000]
     369      CASE(2)
     370        wl1_sun(1:2) = [0.250, 0.690]
     371        wl2_sun(1:2) = [0.690, 4.000]
     372    END SELECT
    403373
    404374    DO ISW=1, NSW
    … …  
    498468     ENDIF ! clef_files
    499469
    500        IF (nqtot>=nqo+1) THEN
    501 !
    502           DO iq=nqo+1,nqtot
    503             iiq=niadv(iq); jq = iq-nqo
    504             dn = 'd'//TRIM(tracers(iiq)%name)//'_'
     470          itr = 0
     471          DO iq = 1, nqtot
     472            IF(.NOT.tracers(iq)%isAdvected .OR. tracers(iq)%isH2Ofamily) CYCLE
     473            itr = itr + 1
     474            dn = 'd'//TRIM(tracers(iq)%name)//'_'
    505475
    506476            flag = [1, 5, 5, 5, 10, 10, 11, 11, 11, 11]
    507             lnam = 'Tracer '//TRIM(tracers(iiq)%longName)
    508             tnam = TRIM(tracers(iiq)%name); o_trac          (jq) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     477            lnam = 'Tracer '//TRIM(tracers(iq)%longName)
     478            tnam = TRIM(tracers(iq)%name);  o_trac          (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     479
    509480            flag = [4, 7, 7, 7, 10, 10, 11, 11, 11, 11]
    510             lnam = 'Tendance tracer '//TRIM(tracers(iiq)%longName)
    511             tnam = TRIM(dn)//'vdf';         o_dtr_vdf       (jq) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     481            lnam = 'Tendance tracer '//TRIM(tracers(iq)%longName)
     482            tnam = TRIM(dn)//'vdf';         o_dtr_vdf       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    512483
    513484            flag = [5, 7, 7, 7, 10, 10, 11, 11, 11, 11]
    514             tnam = TRIM(dn)//'the';         o_dtr_the       (jq) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    515             tnam = TRIM(dn)//'con';         o_dtr_con       (jq) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     485            tnam = TRIM(dn)//'the';         o_dtr_the       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     486            tnam = TRIM(dn)//'con';         o_dtr_con       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    516487
    517488            flag = [7, 7, 7, 7, 10, 10, 11, 11, 11, 11]
    518             tnam = TRIM(dn)//'lessi_impa';  o_dtr_lessi_impa(jq) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    519             tnam = TRIM(dn)//'lessi_nucl';  o_dtr_lessi_nucl(jq) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    520             tnam = TRIM(dn)//'insc';        o_dtr_insc      (jq) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    521             tnam = TRIM(dn)//'bcscav';      o_dtr_bcscav    (jq) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    522             tnam = TRIM(dn)//'evapls';      o_dtr_evapls    (jq) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    523             tnam = TRIM(dn)//'ls';          o_dtr_ls        (jq) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    524             tnam = TRIM(dn)//'trsp';        o_dtr_trsp      (jq) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    525             tnam = TRIM(dn)//'sscav';       o_dtr_sscav     (jq) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    526             tnam = TRIM(dn)//'sat';         o_dtr_sat       (jq) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    527             tnam = TRIM(dn)//'uscav';       o_dtr_uscav     (jq) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    528 
    529             lnam = 'tracer tendency dry deposition'//TRIM(tracers(iiq)%longName)
    530             tnam = 'cum'//TRIM(dn)//'dry';  o_dtr_dry       (jq) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     489            tnam = TRIM(dn)//'lessi_impa';  o_dtr_lessi_impa(itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     490            tnam = TRIM(dn)//'lessi_nucl';  o_dtr_lessi_nucl(itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     491            tnam = TRIM(dn)//'insc';        o_dtr_insc      (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     492            tnam = TRIM(dn)//'bcscav';      o_dtr_bcscav    (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     493            tnam = TRIM(dn)//'evapls';      o_dtr_evapls    (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     494            tnam = TRIM(dn)//'ls';          o_dtr_ls        (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     495            tnam = TRIM(dn)//'trsp';        o_dtr_trsp      (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     496            tnam = TRIM(dn)//'sscav';       o_dtr_sscav     (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     497            tnam = TRIM(dn)//'sat';         o_dtr_sat       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     498            tnam = TRIM(dn)//'uscav';       o_dtr_uscav     (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     499
     500            lnam = 'tracer tendency dry deposition'//TRIM(tracers(iq)%longName)
     501            tnam = 'cum'//TRIM(dn)//'dry';  o_dtr_dry       (itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    531502
    532503            flag = [1, 4, 10, 10, 10, 10, 11, 11, 11, 11]
    533             lnam = 'Cumulated tracer '//TRIM(tracers(iiq)%longName)
    534             tnam = 'cum'//TRIM(tracers(iiq)%name); o_trac_cum(jq)= ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
     504            lnam = 'Cumulated tracer '//TRIM(tracers(iq)%longName)
     505            tnam = 'cum'//TRIM(tracers(iq)%name); o_trac_cum(itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    535506          ENDDO
    536        ENDIF
    537507
    538508   ENDDO !  iff
    … …  
    555525    ENDIF
    556526
    557 !  DO iq=nqo+1,nqtot
    558 !    iiq=niadv(iq)
    559 !    dn = 'd'//TRIM(tracers(iiq)%name)//'_'
    560 !    WRITE(*,'(a,i1,a,10i3)')'trac(',iiq,')%flag = ',o_trac(iiq)%flag
    561 !    WRITE(*,'(a,i1,a)')'trac(',iiq,')%tnam = '//TRIM(o_trac(iiq)%name)
    562 !    WRITE(*,'(a,i1,a)')'trac(',iiq,')%lnam = '//TRIM(o_trac(iiq)%description)
     527!  DO iq=1,nqtot
     528!    IF(.NOT.tracers(iq)%isAdvected .OR. tracers(iq)%isH2Ofamily) CYCLE
     529!    WRITE(*,'(a,i1,a,10i3)')'trac(',iq,')%flag = ',o_trac(iq)%flag
     530!    WRITE(*,'(a,i1,a)')'trac(',iq,')%name = '//TRIM(o_trac(iq)%name)
     531!    WRITE(*,'(a,i1,a)')'trac(',iq,')%description = '//TRIM(o_trac(iq)%description)
    563532!  END DO
    564533

  • LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90

    r4046 r4056  
    2525
    2626    USE dimphy, ONLY: klon, klev, klevp1
    27     USE infotrac_phy, ONLY: nbtr, nqtot, nqo, type_trac, tracers, niadv
     27    USE infotrac_phy, ONLY: nbtr, nqtot, nqo, type_trac, tracers, niso, ntraciso, maxlen
    2828    USE strings_mod,  ONLY: maxlen
    2929    USE mod_phys_lmdz_para, ONLY: is_north_pole_phy,is_south_pole_phy
    … …  
    198198         o_map_emis_Anv, o_map_pcld_Anv, o_map_tcld_Anv, &
    199199         o_map_ntot, o_map_hc,o_map_hist,o_map_Cb,o_map_ThCi,o_map_Anv, &
     200#ifdef ISO
     201! Isotopes
     202         o_xtprecip,o_xtplul,o_xtpluc,o_xtovap,o_xtoliq,o_xtcond, &
     203         o_xtevap,o_dxtdyn,o_dxtldyn,o_dxtcon,o_dxtlsc,o_dxteva, &
     204         o_dxtajs,o_dxtvdf,o_dxtthe, o_dxtch4, &
     205         o_dxtprod_nucl,o_dxtcosmo,o_dxtdecroiss, &
     206#endif
     207! Tropopause
    200208         o_alt_tropo, &
    201 ! Tropopause
    202209         o_p_tropopause, o_z_tropopause, o_t_tropopause,  &
    203210         o_col_O3_strato, o_col_O3_tropo,                 &
    … …  
    254261         rhlevSTD, O3STD, O3daySTD, uvSTD, vqSTD, vTSTD, wqSTD, vphiSTD, &
    255262         wTSTD, u2STD, v2STD, T2STD, missing_val_nf90, delta_sal, ds_ns, &
     263#ifdef ISO
     264        xtrain_con, xtsnow_con, xtrain_fall, xtsnow_fall, &
     265#endif
    256266         dt_ns, delta_sst
    257267
    … …  
    320330         east_gwstress, west_gwstress, &
    321331         d_q_ch4, pmfd, pmfu, ref_liq, ref_ice, rhwriteSTD, &
     332#ifdef ISO
     333        xtrain_lsc, xtsnow_lsc, xt_seri, xtl_seri,xts_seri,xtevap, &
     334        d_xt_dyn,d_xtl_dyn,d_xt_con,d_xt_vdf,d_xt_ajsb, &
     335        d_xt_lsc,d_xt_eva,d_xt_ch4, &
     336        d_xt_ajs, d_xt_ajsb, &
     337        d_xt_prod_nucl,d_xt_cosmo,d_xt_decroiss, &
     338#endif
    322339         ep, epmax_diag, &  ! epmax_cape
    323340         p_tropopause, t_tropopause, z_tropopause
    … …  
    367384    USE pbl_surface_mod, ONLY: snow
    368385    USE indice_sol_mod, ONLY: nbsrf
     386#ifdef ISO
     387    USE isotopes_mod, ONLY: iso_HTO
     388#endif
    369389    USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
    370390    USE surface_data, ONLY: type_ocean, version_ocean, ok_veget, landice_opt
    … …  
    419439    ! Local
    420440    INTEGER :: itau_w
    421     INTEGER :: i, iinit, iinitend=1, iff, iq, iiq, nsrf, k, ll, naero
     441    INTEGER :: i, iinit, iinitend=1, iff, iq, nsrf, k, ll, naero
    422442    REAL, DIMENSION (klon) :: zx_tmp_fi2d, zpt_conv2d, wind100m
    423443    REAL, DIMENSION (klon,klev) :: zx_tmp_fi3d, zpt_conv
    … …  
    439459#endif
    440460    REAL, PARAMETER :: un_jour=86400.
    441     INTEGER ISW
     461    INTEGER :: ISW, itr, ixt, it
    442462    CHARACTER*1 ch1
    443463    CHARACTER(LEN=maxlen) :: varname, dn
    … …  
    452472    REAL,DIMENSION(klon,klev) :: z, dz
    453473    REAL,DIMENSION(klon)      :: zrho, zt
    454 
    455     INTEGER :: nqup
    456 
    457474
    458475    ! On calcul le nouveau tau:
    … …  
    511528          CALL xios_get_handle("fields_strataer_trac_3D", group_handle)
    512529          ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
    513           DO iq=nqo+1, nqtot
    514             iiq=niadv(iq)
    515             dn = 'd'//TRIM(tracers(iiq)%name)//'_'
    516             WRITE (lunout,*) 'XIOS var=', nqo, iq, nqtot, tracers(iiq)%name
     530          DO iq = 1, nqtot
     531            IF(.NOT.tracers(iq)%isAdvected .OR. tracers(iq)%isH2Ofamily) CYCLE
     532            dn = 'd'//TRIM(tracers(iq)%name)//'_'
     533            WRITE (lunout,*) 'XIOS var=', nqo, iq, nqtot, tracers(iq)%name
    517534
    518535            unt = "kg kg-1"
    519             varname=trim(tracers(iiq)%name)
     536            varname=trim(tracers(iq)%name)
    520537            CALL xios_add_child(group_handle, child, varname)
    521538            CALL xios_set_attr(child, name=varname, unit=unt)
    … …  
    561578            CALL xios_add_child(group_handle, child, varname)
    562579            CALL xios_set_attr(child, name=varname, unit=unt)
    563           ENDDO
     580          END DO
    564581          !On ajoute les variables 2D traceurs par l interface fortran
    565582          CALL xios_get_handle("fields_strataer_trac_2D", group_handle)
    566583          ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
    567           DO iq=nqo+1, nqtot
    568             iiq=niadv(iq)
     584          DO iq = 1, nqtot
     585            IF(.NOT.tracers(iq)%isAdvected .OR. tracers(iq)%isH2Ofamily) CYCLE
    569586
    570587            unt = "kg m-2"
    571             varname='cum'//trim(tracers(iiq)%name)
     588            varname='cum'//trim(tracers(iq)%name)
    572589            WRITE (lunout,*) 'XIOS var=', iq, nqtot, varname
    573590            CALL xios_add_child(group_handle, child, varname)
    … …  
    575592
    576593            unt = "kg m-2 s-1"
    577             varname='cumd'//trim(tracers(iiq)%name)//'_dry'
     594            varname='cumd'//trim(tracers(iq)%name)//'_dry'
    578595            CALL xios_add_child(group_handle, child, varname)
    579596            CALL xios_set_attr(child, name=varname, unit=unt)
    … …  
    611628       ENDIf
    612629       CALL histwrite_phy(o_aire, zx_tmp_fi2d)
     630
    613631       IF (vars_defined) THEN
    614632          DO i=1, klon
    … …  
    24082426       IF (iflag_phytrac == 1 ) then
    24092427         IF (type_trac == 'lmdz' .OR. type_trac == 'coag') THEN
    2410            DO iq=nqo+1, nqtot
     2428           itr = 0
     2429           DO iq = 1, nqtot
     2430             IF(tracers(iq)%isH2Ofamily) CYCLE
     2431             itr = itr + 1
     2432!            write(*,*) 'phys_output_write_mod 2337: itr=',itr
    24112433             !--3D fields
    2412              CALL histwrite_phy(o_trac(iq-nqo), tr_seri(:,:,iq-nqo))
    2413              CALL histwrite_phy(o_dtr_vdf(iq-nqo),d_tr_cl(:,:,iq-nqo))
    2414              CALL histwrite_phy(o_dtr_the(iq-nqo),d_tr_th(:,:,iq-nqo))
    2415              CALL histwrite_phy(o_dtr_con(iq-nqo),d_tr_cv(:,:,iq-nqo))
    2416              CALL histwrite_phy(o_dtr_lessi_impa(iq-nqo),d_tr_lessi_impa(:,:,iq-nqo))
    2417              CALL histwrite_phy(o_dtr_lessi_nucl(iq-nqo),d_tr_lessi_nucl(:,:,iq-nqo))
    2418              CALL histwrite_phy(o_dtr_insc(iq-nqo),d_tr_insc(:,:,iq-nqo))
    2419              CALL histwrite_phy(o_dtr_bcscav(iq-nqo),d_tr_bcscav(:,:,iq-nqo))
    2420              CALL histwrite_phy(o_dtr_evapls(iq-nqo),d_tr_evapls(:,:,iq-nqo))
    2421              CALL histwrite_phy(o_dtr_ls(iq-nqo),d_tr_ls(:,:,iq-nqo))
    2422              CALL histwrite_phy(o_dtr_trsp(iq-nqo),d_tr_trsp(:,:,iq-nqo))
    2423              CALL histwrite_phy(o_dtr_sscav(iq-nqo),d_tr_sscav(:,:,iq-nqo))
    2424              CALL histwrite_phy(o_dtr_sat(iq-nqo),d_tr_sat(:,:,iq-nqo))
    2425              CALL histwrite_phy(o_dtr_uscav(iq-nqo),d_tr_uscav(:,:,iq-nqo))
     2434             CALL histwrite_phy(o_trac(itr), tr_seri(:,:,itr))
     2435             CALL histwrite_phy(o_dtr_vdf(itr),d_tr_cl(:,:,itr))
     2436             CALL histwrite_phy(o_dtr_the(itr),d_tr_th(:,:,itr))
     2437             CALL histwrite_phy(o_dtr_con(itr),d_tr_cv(:,:,itr))
     2438             CALL histwrite_phy(o_dtr_lessi_impa(itr),d_tr_lessi_impa(:,:,itr))
     2439             CALL histwrite_phy(o_dtr_lessi_nucl(itr),d_tr_lessi_nucl(:,:,itr))
     2440             CALL histwrite_phy(o_dtr_insc(itr),d_tr_insc(:,:,itr))
     2441             CALL histwrite_phy(o_dtr_bcscav(itr),d_tr_bcscav(:,:,itr))
     2442             CALL histwrite_phy(o_dtr_evapls(itr),d_tr_evapls(:,:,itr))
     2443             CALL histwrite_phy(o_dtr_ls(itr),d_tr_ls(:,:,itr))
     2444             CALL histwrite_phy(o_dtr_trsp(itr),d_tr_trsp(:,:,itr))
     2445             CALL histwrite_phy(o_dtr_sscav(itr),d_tr_sscav(:,:,itr))
     2446             CALL histwrite_phy(o_dtr_sat(itr),d_tr_sat(:,:,itr))
     2447             CALL histwrite_phy(o_dtr_uscav(itr),d_tr_uscav(:,:,itr))
    24262448            !--2D fields
    2427              CALL histwrite_phy(o_dtr_dry(iq-nqo), flux_tr_dry(:,iq-nqo))
     2449             CALL histwrite_phy(o_dtr_dry(itr), flux_tr_dry(:,itr))
    24282450             zx_tmp_fi2d=0.
    24292451             IF (vars_defined) THEN
    24302452                DO k=1,klev
    2431                    zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*tr_seri(:,k,iq-nqo)
     2453                   zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*tr_seri(:,k,itr)
    24322454                ENDDO
    24332455             ENDIF
    2434              CALL histwrite_phy(o_trac_cum(iq-nqo), zx_tmp_fi2d)
     2456             CALL histwrite_phy(o_trac_cum(itr), zx_tmp_fi2d)
    24352457           ENDDO !--iq
    24362458         ENDIF   !--type_trac
    24372459!
    24382460         IF (type_trac == 'co2i') THEN
    2439            DO iq=nqo+1, nqtot
     2461           itr = 0
     2462           DO iq = 1, nqtot
     2463             IF(tracers(iq)%isH2Ofamily) CYCLE
     2464             itr = itr + 1
     2465!            write(*,*) 'phys_output_write_mod 2370: itr=',itr
    24402466             !--3D fields
    2441              CALL histwrite_phy(o_trac(iq-nqo), tr_seri(:,:,iq-nqo))
    2442              CALL histwrite_phy(o_dtr_vdf(iq-nqo),d_tr_cl(:,:,iq-nqo))
    2443              CALL histwrite_phy(o_dtr_the(iq-nqo),d_tr_th(:,:,iq-nqo))
    2444              CALL histwrite_phy(o_dtr_con(iq-nqo),d_tr_cv(:,:,iq-nqo))
     2467             CALL histwrite_phy(o_trac(itr), tr_seri(:,:,itr))
     2468             CALL histwrite_phy(o_dtr_vdf(itr),d_tr_cl(:,:,itr))
     2469             CALL histwrite_phy(o_dtr_the(itr),d_tr_th(:,:,itr))
     2470             CALL histwrite_phy(o_dtr_con(itr),d_tr_cv(:,:,itr))
    24452471             !--2D fields
    24462472             !--CO2 burden
    … …  
    24482474             IF (vars_defined) THEN
    24492475                DO k=1,klev
    2450                    zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*tr_seri(:,k,iq-nqo)
     2476                   zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*tr_seri(:,k,itr)
    24512477                ENDDO
    24522478             ENDIF
    2453              CALL histwrite_phy(o_trac_cum(iq-nqo), zx_tmp_fi2d)
     2479             CALL histwrite_phy(o_trac_cum(itr), zx_tmp_fi2d)
    24542480           ENDDO !--iq
    24552481           !--CO2 net fluxes
    … …  
    24632489
    24642490         IF (type_trac == 'inco') THEN
    2465            nqup = nqo+1
    2466            DO iq=nqo+1, nqup
     2491           DO iq = 1, nqtot
     2492             IF(tracers(iq)%isH2Ofamily .OR. .NOT.tracers(iq)%isAdvected) CYCLE
     2493             itr = itr+1
     2494             IF(tracers(iq)%component /= 'co2i') CYCLE
    24672495             !--3D fields
    2468              CALL histwrite_phy(o_trac(iq-nqo), tr_seri(:,:,iq-nqo))
    2469              CALL histwrite_phy(o_dtr_vdf(iq-nqo),d_tr_cl(:,:,iq-nqo))
    2470              CALL histwrite_phy(o_dtr_the(iq-nqo),d_tr_th(:,:,iq-nqo))
    2471              CALL histwrite_phy(o_dtr_con(iq-nqo),d_tr_cv(:,:,iq-nqo))
     2496             CALL histwrite_phy(o_trac   (itr),tr_seri(:,:,itr))
     2497             CALL histwrite_phy(o_dtr_vdf(itr),d_tr_cl(:,:,itr))
     2498             CALL histwrite_phy(o_dtr_the(itr),d_tr_th(:,:,itr))
     2499             CALL histwrite_phy(o_dtr_con(itr),d_tr_cv(:,:,itr))
    24722500             !--2D fields
    24732501             !--CO2 burden
    … …  
    24752503             IF (vars_defined) THEN
    24762504                DO k=1,klev
    2477                    zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*tr_seri(:,k,iq-nqo)
     2505                   zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*tr_seri(:,k,itr)
    24782506                ENDDO
    24792507             ENDIF
    2480              CALL histwrite_phy(o_trac_cum(iq-nqo), zx_tmp_fi2d)
     2508             CALL histwrite_phy(o_trac_cum(itr), zx_tmp_fi2d)
    24812509           ENDDO !--iq
    24822510           !--CO2 net fluxes
    … …  
    25042532       end if
    25052533
     2534#ifdef ISO
     2535    do ixt=1,ntraciso
     2536!        write(*,*) 'ixt'
     2537        IF (vars_defined) zx_tmp_fi2d(:) = xtrain_fall(ixt,:) + xtsnow_fall(ixt,:)
     2538        CALL histwrite_phy(o_xtprecip(ixt), zx_tmp_fi2d)
     2539
     2540        IF (vars_defined) zx_tmp_fi2d(:) = xtrain_lsc(ixt,:) + xtsnow_lsc(ixt,:)
     2541        CALL histwrite_phy(o_xtplul(ixt), zx_tmp_fi2d)
     2542
     2543        IF (vars_defined) zx_tmp_fi2d(:) = xtrain_con(ixt,:) + xtsnow_con(ixt,:)
     2544        CALL histwrite_phy(o_xtpluc(ixt), zx_tmp_fi2d)
     2545        CALL histwrite_phy(o_xtevap(ixt),   xtevap(ixt,:))
     2546        CALL histwrite_phy(o_xtovap(ixt),  xt_seri(ixt,:,:))
     2547        CALL histwrite_phy(o_xtoliq(ixt), xtl_seri(ixt,:,:))
     2548
     2549        IF (vars_defined) zx_tmp_fi3d(:,:)=xtl_seri(ixt,:,:)+xts_seri(ixt,:,:)
     2550        CALL histwrite_phy(o_xtcond(ixt), zx_tmp_fi3d)
     2551        CALL histwrite_phy(o_dxtdyn(ixt),   d_xt_dyn(ixt,:,:))
     2552        CALL histwrite_phy(o_dxtldyn(ixt), d_xtl_dyn(ixt,:,:))
     2553
     2554        IF (vars_defined) zx_tmp_fi3d(:,:)=d_xt_con(ixt,:,:)/pdtphys
     2555        CALL histwrite_phy(o_dxtcon(ixt), zx_tmp_fi3d)
     2556
     2557        IF (vars_defined) zx_tmp_fi3d(:,:)=d_xt_lsc(ixt,:,:)/pdtphys
     2558        CALL histwrite_phy(o_dxtlsc(ixt), zx_tmp_fi3d)
     2559
     2560        IF (vars_defined) zx_tmp_fi3d(:,:)=d_xt_eva(ixt,:,:)/pdtphys
     2561        CALL histwrite_phy(o_dxteva(ixt), zx_tmp_fi3d)
     2562
     2563        IF (vars_defined) zx_tmp_fi3d(:,:)=d_xt_vdf(ixt,:,:)/pdtphys
     2564        CALL histwrite_phy(o_dxtvdf(ixt), zx_tmp_fi3d)
     2565
     2566        IF (vars_defined) zx_tmp_fi3d(:,:)=d_xt_ajsb(ixt,:,:)/pdtphys
     2567        CALL histwrite_phy(o_dxtajs(ixt), zx_tmp_fi3d)
     2568
     2569        IF (vars_defined) zx_tmp_fi3d(:,:)=(d_xt_ajs(ixt,:,:)-d_xt_ajsb(ixt,:,:))/pdtphys
     2570        CALL histwrite_phy(o_dxtthe(ixt), zx_tmp_fi3d)
     2571
     2572        IF (ok_qch4) THEN
     2573          IF (vars_defined) zx_tmp_fi3d(:,:)=d_xt_ch4(ixt,:,:)/pdtphys
     2574          CALL histwrite_phy(o_dxtch4(ixt), zx_tmp_fi3d)
     2575        END IF
     2576
     2577        IF (ixt == iso_HTO) THEN
     2578          IF (vars_defined) zx_tmp_fi3d(:,:)=d_xt_prod_nucl(ixt,:,:)/pdtphys
     2579          CALL histwrite_phy(o_dxtprod_nucl(ixt), zx_tmp_fi3d)
     2580
     2581          IF (vars_defined) zx_tmp_fi3d(:,:)=d_xt_cosmo(ixt,:,:)/pdtphys
     2582          CALL histwrite_phy(o_dxtcosmo(ixt), zx_tmp_fi3d)
     2583
     2584          IF (vars_defined) zx_tmp_fi3d(:,:)=d_xt_decroiss(ixt,:,:)/pdtphys
     2585          CALL histwrite_phy(o_dxtdecroiss(ixt), zx_tmp_fi3d)
     2586        END IF
     2587
     2588    !write(*,*) 'phys_output_write_mod 2531'
     2589    enddo !do ixt=1,ntraciso   
     2590#endif
     2591
    25062592       IF (.NOT.vars_defined) THEN
    25072593          !$OMP MASTER

  • LMDZ6/trunk/libf/phylmd/physiq_mod.F90

    r4009 r4056  
    3939    USE ioipsl_getin_p_mod, ONLY : getin_p
    4040    USE indice_sol_mod
    41     USE infotrac_phy, ONLY: nqtot, nbtr, nqo, type_trac, nqCO2
     41    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac, nqCO2
     42    USE readTracFiles_mod, ONLY: phases_sep
     43    USE strings_mod,  ONLY: strIdx
    4244    USE iophy
    4345    USE limit_read_mod, ONLY : init_limit_read
    … …  
    146148       !
    147149       d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_t_diss, &
     150       d_t_vdf_x, d_t_vdf_w, &
     151       d_q_vdf_x, d_q_vdf_w, &
    148152       d_ts, &
    149153       !
    … …  
    218222       zxfluxlat_x, zxfluxlat_w, &
    219223       !
    220        d_t_vdf_x, d_t_vdf_w, &
    221        d_q_vdf_x, d_q_vdf_w, &
    222224       pbl_tke_input, tke_dissip, l_mix, wprime,&
    223225       t_therm, q_therm, u_therm, v_therm, &
    … …  
    356358    LOGICAL, SAVE :: ok_volcan ! pour activer les diagnostics volcaniques
    357359    !$OMP THREADPRIVATE(ok_volcan)
    358     INTEGER, SAVE :: flag_volc_surfstrat ! pour imposer le cool/heat rate à la surf ou dans la strato
     360    INTEGER, SAVE :: flag_volc_surfstrat ! pour imposer le cool/heat rate à la surf/strato
    359361    !$OMP THREADPRIVATE(flag_volc_surfstrat)
    360362    LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE
    … …  
    854856    real zqsat(klon,klev)
    855857    !
    856     INTEGER i, k, iq, j, nsrf, ll, l
     858    INTEGER i, k, iq, j, nsrf, ll, l, itr
    857859    !
    858860    REAL t_coup
    … …  
    10351037
    10361038    CHARACTER (LEN=20) :: modname='physiq_mod'
    1037     CHARACTER*80 message, abort_message
     1039    CHARACTER*80 abort_message
    10381040    LOGICAL, SAVE ::  ok_sync, ok_sync_omp
    10391041    !$OMP THREADPRIVATE(ok_sync)
    … …  
    13631365         iflag_phytrac = 1
    13641366       ENDIF
    1365 #endif 
     1367#endif
    13661368       nvm_lmdz = 13
    13671369       CALL getin_p('NVM',nvm_lmdz)
    … …  
    22302232
    22312233    tke0(:,:)=pbl_tke(:,:,is_ave)
    2232     !CR:Nombre de traceurs de l'eau: nqo
    2233     !  IF (nqtot.GE.3) THEN
    2234     IF (nqtot.GE.(nqo+1)) THEN
    2235        !     DO iq = 3, nqtot       
    2236        DO iq = nqo+1, nqtot 
     2234    IF (nqtot > nqo) THEN
     2235       ! water isotopes are not included in tr_seri
     2236       itr = 0
     2237       DO iq = 1, nqtot
     2238         IF(tracers(iq)%isH2Ofamily) CYCLE
     2239         itr = itr+1
    22372240          DO  k = 1, klev
    22382241             DO  i = 1, klon
    2239                 !              tr_seri(i,k,iq-2) = qx(i,k,iq)
    2240                 tr_seri(i,k,iq-nqo) = qx(i,k,iq)
     2242                tr_seri(i,k,itr) = qx(i,k,iq)
    22412243             ENDDO
    22422244          ENDDO
    22432245       ENDDO
    22442246    ELSE
    2245        DO k = 1, klev
    2246           DO i = 1, klon
    2247              tr_seri(i,k,1) = 0.0
    2248           ENDDO
    2249        ENDDO
     2247! DC: make sure the final "1" index was meant for 1st H2O phase (vapor) !!!
     2248!       tr_seri(:,:,strIdx(tracers(:)%name,'H2O'//phases_sep//'g')) = 0.0
     2249       tr_seri(:,:,strIdx(tracers(:)%name,'H2Ov')) = 0.0
    22502250    ENDIF
    22512251!
    … …  
    22542254    IF (debut) THEN
    22552255      WRITE(lunout,*)' WARNING: tr_ancien initialised to tr_seri'
    2256       DO iq = nqo+1, nqtot
    2257            tr_ancien(:,:,iq-nqo)=tr_seri(:,:,iq-nqo)
    2258       ENDDO
     2256       itr = 0
     2257       do iq = 1, nqtot
     2258         IF(tracers(iq)%isH2Ofamily) CYCLE
     2259         itr = itr+1
     2260         tr_ancien(:,:,itr)=tr_seri(:,:,itr)       
     2261       enddo
    22592262    ENDIF
    22602263    !
    … …  
    22872290       d_qs_dyn2d(:)=(zx_tmp_fi2d(:)-prsw_ancien(:))/phys_tstep
    22882291       ! !! RomP >>>   td dyn traceur
    2289        IF (nqtot.GT.nqo) THEN     ! jyg
    2290           DO iq = nqo+1, nqtot      ! jyg
    2291               d_tr_dyn(:,:,iq-nqo)=(tr_seri(:,:,iq-nqo)-tr_ancien(:,:,iq-nqo))/phys_tstep ! jyg
    2292           ENDDO
    2293        ENDIF
     2292       IF (nqtot > nqo) d_tr_dyn(:,:,:)=(tr_seri(:,:,:)-tr_ancien(:,:,:))/phys_tstep
    22942293       ! !! RomP <<<
    22952294    ELSE
    … …  
    23042303       d_qs_dyn2d(:) = 0.0
    23052304       ! !! RomP >>>   td dyn traceur
    2306        IF (nqtot.GT.nqo) THEN                                       ! jyg
    2307           DO iq = nqo+1, nqtot                                      ! jyg
    2308               d_tr_dyn(:,:,iq-nqo)= 0.0                             ! jyg
    2309           ENDDO
    2310        ENDIF
     2305       IF (nqtot > nqo) d_tr_dyn(:,:,:)= 0.0
    23112306       ! !! RomP <<<
    23122307       ancien_ok = .TRUE.
    … …  
    25892584            debut,     lafin, &
    25902585            longitude_deg, latitude_deg, rugoro,  zrmu0,      &
    2591              sollwdown,    cldt,      &
     2586            sollwdown,    cldt,      &
    25922587            rain_fall, snow_fall, solsw,   solswfdiff, sollw,     &
    25932588            gustiness,                                &
    … …  
    28572852         ENDDO
    28582853       ELSE
    2859                t_w(:,:) = t_seri(:,:)
     2854                t_w(:,:) = t_seri(:,:)
    28602855                q_w(:,:) = q_seri(:,:)
    28612856                t_x(:,:) = t_seri(:,:)
    … …  
    30733068
    30743069       DO i = 1, klon
    3075           ema_pcb(i)  = paprs(i,ibas_con(i))
     3070          ! C Risi modif: pour éviter pb de dépassement d'indice dans les cas
     3071          ! où i n'est pas un point convectif et donc ibas_con(i)=0
     3072          ! c'est un pb indépendant des isotopes
     3073          if (ibas_con(i) > 0) then
     3074             ema_pcb(i)  = paprs(i,ibas_con(i))
     3075          else
     3076             ema_pcb(i)  = 0.0
     3077          endif
    30763078       ENDDO
    30773079       DO i = 1, klon
    … …  
    35043506    wprime_ave(:,:)=0.
    35053507
    3506 
    35073508    DO nsrf = 1, nbsrf
    35083509       DO i = 1, klon
    … …  
    35123513       ENDDO
    35133514    ENDDO
    3514 
    35153515
    35163516    CALL  calcratqs(klon,klev,prt_level,lunout,        &
    … …  
    35303530       print *,'itap, ->fisrtilp ',itap
    35313531    ENDIF
     3532    !
    35323533
    35333534    picefra(:,:)=0.
    … …  
    35563557         iflag_ice_thermo)
    35573558    ENDIF
     3559    !
    35583560    WHERE (rain_lsc < 0) rain_lsc = 0.
    35593561    WHERE (snow_lsc < 0) snow_lsc = 0.
    … …  
    42674269 
    42684270#ifndef CPP_XIOS
    4269 
     4271          !--OB 30/05/2016 modified 21/10/2016
     4272          !--here we return swaero_diag and dryaod_diag to FALSE
     4273          !--and histdef will switch it back to TRUE if necessary
     4274          !--this is necessary to get the right swaero at first step
     4275          !--but only in the case of no XIOS as XIOS is covered elsewhere
     4276          IF (debut) swaerofree_diag = .FALSE.
     4277          IF (debut) swaero_diag = .FALSE.
     4278          IF (debut) dryaod_diag = .FALSE.
     4279          !--IM 15/09/2017 here we return ok_4xCO2atm to FALSE
     4280          !--as for swaero_diag, see above
     4281          IF (debut) ok_4xCO2atm = .FALSE.
     4282
     4283          !
    42704284          !IM 2eme calcul radiatif pour le cas perturbe ou au moins un
    42714285          !IM des taux doit etre different du taux actuel
    … …  
    50525066    ENDDO
    50535067    !
    5054     !CR: nb de traceurs eau: nqo
    5055     !  IF (nqtot.GE.3) THEN
    5056     IF (nqtot.GE.(nqo+1)) THEN
    5057        !     DO iq = 3, nqtot
    5058        DO iq = nqo+1, nqtot
     5068    IF (nqtot > nqo+1) THEN
     5069       itr = 0
     5070       DO iq = 1, nqtot
     5071          IF(tracers(iq)%isH2Ofamily) CYCLE
     5072          itr = itr+1
    50595073          DO  k = 1, klev
    50605074             DO  i = 1, klon
    5061                 ! d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / phys_tstep
    5062                 d_qx(i,k,iq) = ( tr_seri(i,k,iq-nqo) - qx(i,k,iq) ) / phys_tstep
     5075                d_qx(i,k,iq) = ( tr_seri(i,k,itr) - qx(i,k,iq) ) / phys_tstep
    50635076             ENDDO
    50645077          ENDDO
    … …  
    51015114    CALL water_int(klon,klev,qs_ancien,zmasse,prsw_ancien)
    51025115    ! !! RomP >>>
    5103     !CR: nb de traceurs eau: nqo
    5104     IF (nqtot.GT.nqo) THEN
    5105        DO iq = nqo+1, nqtot
    5106           tr_ancien(:,:,iq-nqo) = tr_seri(:,:,iq-nqo)
    5107        ENDDO
    5108     ENDIF
     5116    IF (nqtot > nqo) tr_ancien(:,:,:) = tr_seri(:,:,:)
    51095117    ! !! RomP <<<
    51105118    !==========================================================================

  • LMDZ6/trunk/libf/phylmd/phytrac_mod.F90

    r4012 r4056  
    5656  SUBROUTINE phytrac_init()
    5757    USE dimphy
    58     USE infotrac_phy, ONLY: nbtr, nqCO2, type_trac
     58    USE infotrac_phy, ONLY: nbtr, type_trac
    5959    USE tracco2i_mod, ONLY: tracco2i_init
    6060    IMPLICIT NONE
    … …  
    145145    USE phys_local_var_mod, ONLY: budg_dep_dry_h2so4, budg_dep_wet_h2so4
    146146    USE phys_local_var_mod, ONLY: budg_dep_dry_part,  budg_dep_wet_part
    147     USE infotrac, ONLY: nbtr_sulgas, id_OCS_strat, id_SO2_strat, id_H2SO4_strat
     147    USE infotrac_phy, ONLY: nbtr_sulgas, id_OCS_strat, id_SO2_strat, id_H2SO4_strat
    148148    USE aerophys
    149149#endif
    … …  
    508508          iflag_con_trac= 1
    509509       CASE('inco')
    510           source(:,1:nqCO2) = 0.                          ! from CO2i   ModThL
    511           source(:,nqCO2+1:nbtr)=init_source(:,:)         ! from INCA   ModThL
    512           aerosol(1:nqCO2) = .FALSE.                      ! from CO2i   ModThL
    513           CALL tracinca_init(aerosol(nqCO2+1:nbtr),lessivage)     ! from INCA   ModThL
    514           pbl_flg(1:nqCO2) = 1              ! From CO2i         ModThL
    515           iflag_the_trac= 1           ! From CO2i
    516           iflag_vdf_trac= 1           ! From CO2i
    517           iflag_con_trac= 1           ! From CO2i
     510          source(:,1:nqCO2) = 0.                          ! from CO2i ModThL
     511          source(:,nqCO2+1:nbtr)=init_source(:,:)         ! from INCA ModThL
     512          aerosol(1:nqCO2) = .FALSE.                      ! from CO2i ModThL
     513          CALL tracinca_init(aerosol(nqCO2+1:nbtr),lessivage)     ! from INCA ModThL
     514          pbl_flg(1:nqCO2) = 1                            ! From CO2i ModThL
     515          iflag_the_trac = 1                              ! From CO2i
     516          iflag_vdf_trac = 1                              ! From CO2i
     517          iflag_con_trac = 1                              ! From CO2i
    518518#ifdef CPP_StratAer
    519519       CASE('coag')

  • LMDZ6/trunk/libf/phylmd/traclmdz_mod.F90

    r4050 r4056  
    6767   
    6868    USE dimphy
    69     USE infotrac_phy, ONLY: nbtr, tracers, niadv, solsym
     69    USE infotrac_phy, ONLY: nbtr
    7070   
    7171    ! Input argument
    … …  
    8989    ! Initialization of the tracers should be done here only for those not found in the restart file.
    9090    USE dimphy
    91     USE infotrac_phy, ONLY: nbtr, nqo, tracers, pbl_flg, conv_flg, niadv
     91    USE infotrac_phy, ONLY: nbtr, nqtot, tracers, pbl_flg, conv_flg
    9292    USE regr_pr_comb_coefoz_m, ONLY: alloc_coefoz
    9393    USE press_coefoz_m, ONLY: press_coefoz
    … …  
    114114       
    115115! Local variables   
    116     INTEGER :: ierr, it, iiq, i, k
     116    INTEGER :: ierr, it, iq, i, k
    117117    REAL, DIMENSION(klon_glo,klev) :: varglo ! variable temporaire sur la grille global   
    118118    REAL, DIMENSION(klev)          :: mintmp, maxtmp
    … …  
    173173    id_rn=0; id_pb=0; id_aga=0; id_be=0; id_o3=0
    174174    id_pcsat=0; id_pcocsat=0; id_pcq=0; id_pcs0=0; id_pcos0=0; id_pcq0=0
    175     DO it=1,nbtr
    176 !!       iiq=niadv(it+2)                                                            ! jyg
    177        iiq=niadv(it+nqo)                                                            ! jyg
    178        SELECT CASE(strLower(tracers(iiq)%name))
     175    it = 0
     176    DO iq = 1, nqtot
     177       IF(.NOT.tracers(iq)%isAdvected .OR. tracers(iq)%isH2Ofamily) CYCLE
     178       it = it+1
     179       SELECT CASE(strLower(tracers(iq)%name))
    179180         CASE("rn");      id_rn     = it ! radon
    180181         CASE("pb");      id_pb     = it ! plomb
    … …  
    189190         CASE("pcq0");    id_pcq0   = it
    190191         CASE DEFAULT
    191            WRITE(lunout,*) 'This is an unknown tracer in LMDZ : ', trim(tracers(iiq)%name)
     192           WRITE(lunout,*) 'This is an unknown tracer in LMDZ : ', trim(tracers(iq)%name)
    192193       END SELECT
    193194
    194        SELECT CASE(strLower(tracers(iiq)%name))
     195       SELECT CASE(strLower(tracers(iq)%name))
    195196         CASE("pb")                        !--- RomP >>> profil initial de PB210
    196197           OPEN(ilesfil2,file='prof.pb210',status='old',iostat=irr2)
    … …  
    259260! Check if all tracers have restart values
    260261! ----------------------------------------------
    261     DO it=1,nbtr
    262 !!       iiq=niadv(it+2)                                                            ! jyg
    263        iiq=niadv(it+nqo)                                                            ! jyg
     262    it = 0
     263    DO iq = 1, nqtot
     264       IF(.NOT.tracers(iq)%isAdvected .OR. tracers(iq)%isH2Ofamily) CYCLE
     265       it = it+1
    264266       ! Test if tracer is zero everywhere.
    265267       ! Done by master process MPI and master thread OpenMP
    … …  
    282284       IF (zero) THEN
    283285          ! The tracer was not found in restart file or it was equal zero everywhere.
    284           WRITE(lunout,*) "The tracer ",trim(tracers(iiq)%name)," will be initialized"
     286          WRITE(lunout,*) "The tracer ",trim(tracers(iq)%name)," will be initialized"
    285287          IF (it==id_pcsat .OR. it==id_pcq .OR. &
    286288               it==id_pcs0 .OR. it==id_pcq0) THEN
Note: See TracChangeset for help on using the changeset viewer.