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/Dust
Files:
6 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)
Note: See TracChangeset for help on using the changeset viewer.