Ignore:
Timestamp:
Nov 19, 2021, 4:58:59 PM (3 years ago)
Author:
lguez
Message:

Sync latest trunk changes to Ocean_skin

Location:
LMDZ6/branches/Ocean_skin
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Ocean_skin

  • LMDZ6/branches/Ocean_skin/libf/dyn3d_common/infotrac.F90

    r3811 r4013  
    1212  INTEGER, SAVE :: nbtr
    1313
    14 ! CRisi: nb traceurs pères= directement advectés par l'air
     14! CRisi: on retranche les isotopes des traceurs habituels
     15! On fait un tableaux d'indices des traceurs qui passeront dans phytrac
     16  INTEGER, SAVE :: nqtottr
     17  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: itr_indice
     18
     19! CRisi: nb traceurs peres= directement advectes par l'air
    1520  INTEGER, SAVE :: nqperes
    1621
     22! ThL: nb traceurs INCA
     23  INTEGER, SAVE :: nqINCA
     24
     25! ThL: nb traceurs CO2
     26  INTEGER, SAVE :: nqCO2
     27
    1728! Name variables
    18   CHARACTER(len=20), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics
    19   CHARACTER(len=23), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics
     29  INTEGER,PARAMETER :: tname_lenmax=128
     30  CHARACTER(len=tname_lenmax), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics
     31  CHARACTER(len=tname_lenmax+3), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics
    2032
    2133! iadv  : index of trasport schema for each tracer
    … …  
    2840! CRisi: tableaux de fils
    2941  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqfils
    30   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les générations
     42  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les generations
    3143  INTEGER, SAVE :: nqdesc_tot
    3244  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE    :: iqfils
    … …  
    4254  CHARACTER(len=4),SAVE :: type_trac
    4355  CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym
    44    
     56
    4557! CRisi: cas particulier des isotopes
    4658  LOGICAL,SAVE :: ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso
    … …  
    5062  LOGICAL, DIMENSION(niso_possibles),SAVE ::  use_iso
    5163  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  iqiso ! donne indice iq en fn de (ixt,phase)
    52   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_num ! donne numéro iso entre 1 et niso_possibles en fn de nqtot
    53   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot
    54   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  zone_num ! donne numéro de la zone de tracage en fn de nqtot
    55   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  phase_num ! donne numéro de la zone de tracage en fn de nqtot
    56   INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numéro d isotope entre 1 et niso_possibles
    57   INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  index_trac ! numéro ixt en fn izone, indnum entre 1 et niso
     64  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_num ! donne numero iso entre 1 et niso_possibles en fn de nqtot
     65  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_indnum ! donne numero iso entre 1 et niso effectif en fn de nqtot
     66  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  zone_num ! donne numero de la zone de tracage en fn de nqtot
     67  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  phase_num ! donne numero de la zone de tracage en fn de nqtot
     68  INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numero d isotope entre 1 et niso_possibles
     69  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  index_trac ! numero ixt en fn izone, indnum entre 1 et niso
    5870  INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso
    5971
    … …  
    103115    INTEGER, ALLOCATABLE, DIMENSION(:) :: vadv_inca  ! index of vertical trasport schema
    104116
    105     CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
    106     CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_transp ! transporting fluid short name: CRisi
     117    INTEGER, ALLOCATABLE, DIMENSION(:) :: conv_flg_inca
     118    INTEGER, ALLOCATABLE, DIMENSION(:) :: pbl_flg_inca
     119    CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: solsym_inca
     120
     121    CHARACTER(len=tname_lenmax), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
     122    CHARACTER(len=tname_lenmax), ALLOCATABLE, DIMENSION(:) :: tnom_transp ! transporting fluid short name: CRisi
    107123    CHARACTER(len=3), DIMENSION(30) :: descrq
    108124    CHARACTER(len=1), DIMENSION(3)  :: txts
    109125    CHARACTER(len=2), DIMENSION(9)  :: txtp
    110     CHARACTER(len=23)               :: str1,str2
     126    CHARACTER(len=tname_lenmax)               :: str1,str2
    111127 
    112128    INTEGER :: nqtrue  ! number of tracers read from tracer.def, without higer order of moment
    113     INTEGER :: iq, new_iq, iiq, jq, ierr
     129    INTEGER :: iq, new_iq, iiq, jq, ierr,itr
    114130    INTEGER :: ifils,ipere,generation ! CRisi
    115131    LOGICAL :: continu,nouveau_traceurdef
    116132    INTEGER :: IOstatus ! gestion de la retrocompatibilite de traceur.def
    117     CHARACTER(len=15) :: tchaine   
     133    CHARACTER(len=2*tname_lenmax+1) :: tchaine   
    118134
    119135    character(len=*),parameter :: modname="infotrac_init"
     136
    120137!-----------------------------------------------------------------------
    121138! Initialization :
    … …  
    138155    ! Coherence test between parameter type_trac, config_inca and preprocessing keys
    139156    IF (type_trac=='inca') THEN
    140        WRITE(lunout,*) 'You have choosen to couple with INCA chemestry model : type_trac=', &
     157       WRITE(lunout,*) 'You have chosen to couple with INCA chemistry model : type_trac=', &
    141158            type_trac,' config_inca=',config_inca
    142159       IF (config_inca/='aero' .AND. config_inca/='aeNP' .AND. config_inca/='chem') THEN
    143160          WRITE(lunout,*) 'Incoherence between type_trac and config_inca. Model stops. Modify run.def'
    144161          CALL abort_gcm('infotrac_init','Incoherence between type_trac and config_inca',1)
    145        END IF
     162       ENDIF
    146163#ifndef INCA
    147164       WRITE(lunout,*) 'To run this option you must add cpp key INCA and compile with INCA code'
    … …  
    149166#endif
    150167    ELSE IF (type_trac=='repr') THEN
    151        WRITE(lunout,*) 'You have choosen to couple with REPROBUS chemestry model : type_trac=', type_trac
     168       WRITE(lunout,*) 'You have chosen to couple with REPROBUS chemestry model : type_trac=', type_trac
    152169#ifndef REPROBUS
    153170       WRITE(lunout,*) 'To run this option you must add cpp key REPROBUS and compile with REPRPBUS code'
    … …  
    164181    ELSE IF (type_trac == 'lmdz') THEN
    165182       WRITE(lunout,*) 'Tracers are treated in LMDZ only : type_trac=', type_trac
     183    ELSE IF (type_trac == 'inco') THEN ! ThL
     184       WRITE(lunout,*) 'Using jointly INCA and CO2 cycle: type_trac =', type_trac
     185       IF (config_inca/='aero' .AND. config_inca/='aeNP' .AND. config_inca/='chem') THEN
     186          WRITE(lunout,*) 'Incoherence between type_trac and config_inca. Model stops. Modify run.def'
     187          CALL abort_gcm('infotrac_init','Incoherence between type_trac and config_inca',1)
     188       ENDIF
     189#ifndef INCA
     190       WRITE(lunout,*) 'To run this option you must add cpp key INCA and compilewith INCA code'
     191       CALL abort_gcm('infotrac_init','You must compile with cpp key INCA',1)
     192#endif   
    166193    ELSE
    167194       WRITE(lunout,*) 'type_trac=',type_trac,' not possible. Model stops'
    168195       CALL abort_gcm('infotrac_init','bad parameter',1)
    169     END IF
     196    ENDIF
    170197
    171198    ! Test if config_inca is other then none for run without INCA
    172     IF (type_trac/='inca' .AND. config_inca/='none') THEN
     199    IF (type_trac/='inca' .AND. type_trac/='inco' .AND. config_inca/='none') THEN
    173200       WRITE(lunout,*) 'config_inca will now be changed to none as you do not couple with INCA model'
    174201       config_inca='none'
    175     END IF
     202    ENDIF
    176203
    177204!-----------------------------------------------------------------------
    … …  
    182209!-----------------------------------------------------------------------
    183210    IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag' .OR. type_trac == 'co2i') THEN
     211       IF (type_trac=='co2i') THEN
     212          nqCO2 = 1
     213       ELSE
     214          nqCO2 = 0
     215       ENDIF
    184216       OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
    185217       IF(ierr.EQ.0) THEN
    … …  
    188220          write(lunout,*) 'nqtrue=',nqtrue
    189221       ELSE
    190           WRITE(lunout,*) trim(modname),': Problem in opening traceur.def'
    191           WRITE(lunout,*) trim(modname),': WARNING using defaut values'
    192           IF (planet_type=='earth') THEN
    193             nqtrue=4 ! Default value for Earth
    194           ELSE
    195             nqtrue=1 ! Default value for other planets
    196           ENDIF
     222          WRITE(lunout,*) trim(modname),': Failed opening traceur.def'
     223          CALL abort_gcm(modname,"file traceur.def not found!",1)
    197224       ENDIF
    198225!jyg<
    … …  
    206233!!       endif
    207234!>jyg
    208     ELSE ! type_trac=inca
     235    ELSE ! type_trac=inca or inco
     236       IF (type_trac=='inco') THEN
     237          nqCO2 = 1
     238       ELSE
     239          nqCO2 = 0
     240       ENDIF
    209241!jyg<
    210242       ! The traceur.def file is used to define the number "nqo" of water phases
    … …  
    215247          READ(90,*) nqo
    216248       ELSE
    217           WRITE(lunout,*) trim(modname),': Using default value for nqo'
    218           nqo=2
     249          WRITE(lunout,*) trim(modname),': Failed opening traceur.def'
     250          CALL abort_gcm(modname,"file traceur.def not found!",1)
    219251       ENDIF
    220252       IF (nqo /= 2 .AND. nqo /= 3 ) THEN
    221           WRITE(lunout,*) trim(modname),': nqo=',nqo, ' is not allowded. Only 2 or 3 water phases allowed'
     253          IF (nqo == 4 .AND. type_trac=='inco') THEN ! ThL
     254             WRITE(lunout,*) trim(modname),': you are coupling with INCA, and also using CO2i.'
     255             nqo = 3    ! A ameliorier... je force 3 traceurs eau...  ThL
     256             WRITE(lunout,*) trim(modname),': nqo = ',nqo
     257          ELSE
     258          WRITE(lunout,*) trim(modname),': nqo=',nqo, ' is not allowed. Only 2 or 3 water phases allowed'
    222259          CALL abort_gcm('infotrac_init','Bad number of water phases',1)
    223        END IF
     260          ENDIF
     261       ENDIF
    224262       ! nbtr has been read from INCA by init_const_lmdz() in gcm.F
    225263#ifdef INCA
    226        CALL Init_chem_inca_trac(nbtr)
    227 #endif       
     264       CALL Init_chem_inca_trac(nqINCA)
     265#else
     266       nqINCA=0
     267#endif
     268       nbtr=nqINCA+nqCO2
    228269       nqtrue=nbtr+nqo
    229 
    230        ALLOCATE(hadv_inca(nbtr), vadv_inca(nbtr))
    231 
    232     ENDIF   ! type_trac
     270       WRITE(lunout,*) trim(modname),': nqo = ',nqo
     271       WRITE(lunout,*) trim(modname),': nbtr = ',nbtr
     272       WRITE(lunout,*) trim(modname),': nqtrue = ',nqtrue
     273       WRITE(lunout,*) trim(modname),': nqCO2 = ',nqCO2
     274       WRITE(lunout,*) trim(modname),': nqINCA = ',nqINCA
     275       ALLOCATE(hadv_inca(nqINCA), vadv_inca(nqINCA), conv_flg_inca(nqINCA), pbl_flg_inca(nqINCA), solsym_inca(nqINCA))
     276    ENDIF   ! type_trac 'inca' ou 'inco'
    233277!>jyg
    234278
    235279    IF ((planet_type=="earth").and.(nqtrue < 2)) THEN
    236        WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
     280       WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowed. 2 tracers is the minimum'
    237281       CALL abort_gcm('infotrac_init','Not enough tracers',1)
    238     END IF
     282    ENDIF
    239283   
    240284!jyg<
    241 ! Transfert number of tracers to Reprobus
    242 !!    IF (type_trac == 'repr') THEN
    243 !!#ifdef REPROBUS
    244 !!       CALL Init_chem_rep_trac(nbtr)
    245 !!#endif
    246 !!    END IF
    247 !>jyg
    248285       
    249286!
    … …  
    252289    ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue),tnom_transp(nqtrue))
    253290
    254 !
    255 !jyg<
    256 !!    ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr))
    257 !!    conv_flg(:) = 1 ! convection activated for all tracers
    258 !!    pbl_flg(:)  = 1 ! boundary layer activated for all tracers
    259 !>jyg
    260291
    261292!-----------------------------------------------------------------------
    … …  
    271302!     iadv = 13   schema  Frederic Hourdin II
    272303!     iadv = 16   schema  PPM Monotone(Collela & Woodward 1984)
    273 !     iadv = 17   schema  PPM Semi Monotone (overshoots autorisés)
    274 !     iadv = 18   schema  PPM Positif Defini (overshoots undershoots autorisés)
     304!     iadv = 17   schema  PPM Semi Monotone (overshoots autorises)
     305!     iadv = 18   schema  PPM Positif Defini (overshoots undershoots autorises)
    275306!     iadv = 20   schema  Slopes
    276307!     iadv = 30   schema  Prather
    … …  
    286317!---------------------------------------------------------------------
    287318    IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag' .OR. type_trac == 'co2i') THEN
    288        IF(ierr.EQ.0) THEN
     319
    289320          ! Continue to read tracer.def
    290321          DO iq=1,nqtrue
    … …  
    319350                write(lunout,*) 'C''est la nouvelle version de traceur.def'
    320351                tnom_0(iq)=tchaine(1:iiq-1)
    321                 tnom_transp(iq)=tchaine(iiq+1:15)
     352                tnom_transp(iq)=tchaine(iiq+1:)
    322353             else
    323354                write(lunout,*) 'C''est l''ancienne version de traceur.def'
    … …  
    329360             write(lunout,*) 'tnom_transp(iq)=<',trim(tnom_transp(iq)),'>'
    330361
    331           END DO !DO iq=1,nqtrue
     362          ENDDO!DO iq=1,nqtrue
     363
    332364          CLOSE(90) 
    333365
    334        ELSE ! Without tracer.def, set default values
    335          if (planet_type=="earth") then
    336           ! for Earth, default is to have 4 tracers
    337           hadv(1) = 14
    338           vadv(1) = 14
    339           tnom_0(1) = 'H2Ov'
    340           tnom_transp(1) = 'air'
    341           hadv(2) = 10
    342           vadv(2) = 10
    343           tnom_0(2) = 'H2Ol'
    344           tnom_transp(2) = 'air'
    345           hadv(3) = 10
    346           vadv(3) = 10
    347           tnom_0(3) = 'RN'
    348           tnom_transp(3) = 'air'
    349           hadv(4) = 10
    350           vadv(4) = 10
    351           tnom_0(4) = 'PB'
    352           tnom_transp(4) = 'air'
    353          else ! default for other planets
    354           hadv(1) = 10
    355           vadv(1) = 10
    356           tnom_0(1) = 'dummy'
    357           tnom_transp(1) = 'dummy'
    358          endif ! of if (planet_type=="earth")
    359        END IF
    360        
    361366       WRITE(lunout,*) trim(modname),': Valeur de traceur.def :'
    362        WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue
     367       WRITE(lunout,*) trim(modname),': nombre total de traceurs ',nqtrue
    363368       DO iq=1,nqtrue
    364           WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq),tnom_transp(iq)
     369          WRITE(lunout,*) hadv(iq),vadv(iq),' ',trim(tnom_0(iq)),' ',trim(tnom_transp(iq))
    365370       END DO
    366371
    … …  
    418423#endif
    419424
    420     ENDIF  ! (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac = 'coag')
     425    ENDIF  ! (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac = 'coag' .OR. type_trac = 'co2i')
    421426!jyg<
    422427!
     428
    423429! Transfert number of tracers to Reprobus
    424430    IF (type_trac == 'repr') THEN
    … …  
    426432       CALL Init_chem_rep_trac(nbtr,nqo,tnom_0)
    427433#endif
    428     END IF
     434    ENDIF
    429435!
    430436! Allocate variables depending on nbtr
    … …  
    433439    conv_flg(:) = 1 ! convection activated for all tracers
    434440    pbl_flg(:)  = 1 ! boundary layer activated for all tracers
    435 !
    436 !!    ELSE  ! type_trac=inca : config_inca='aero' ou 'chem'
    437 !
    438     IF (type_trac == 'inca') THEN   ! config_inca='aero' ou 'chem'
     441
     442    IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN   ! config_inca='aero' ou 'chem'
    439443!>jyg
    440444! le module de chimie fournit les noms des traceurs
    441445! et les schemas d'advection associes. excepte pour ceux lus
    442446! dans traceur.def
    443        IF (ierr .eq. 0) then
    444           DO iq=1,nqo
     447
     448          DO iq=1,nqo+nqCO2
    445449
    446450             write(*,*) 'infotrac 237: iq=',iq
    … …  
    459463             nouveau_traceurdef=.false.
    460464             iiq=1
     465
    461466             do while (continu)
    462467                if (tchaine(iiq:iiq).eq.' ') then
    … …  
    469474                endif
    470475             enddo
     476
    471477             write(*,*) 'iiq,nouveau_traceurdef=',iiq,nouveau_traceurdef
     478
    472479             if (nouveau_traceurdef) then
    473480                write(lunout,*) 'C''est la nouvelle version de traceur.def'
    474481                tnom_0(iq)=tchaine(1:iiq-1)
    475                 tnom_transp(iq)=tchaine(iiq+1:15)
     482                tnom_transp(iq)=tchaine(iiq+1:)
    476483             else
    477484                write(lunout,*) 'C''est l''ancienne version de traceur.def'
    … …  
    480487                tnom_transp(iq) = 'air'
    481488             endif
     489
    482490             write(lunout,*) 'tnom_0(iq)=<',trim(tnom_0(iq)),'>'
    483491             write(lunout,*) 'tnom_transp(iq)=<',trim(tnom_transp(iq)),'>'
    484492
    485           END DO !DO iq=1,nqtrue
     493          ENDDO  !DO iq=1,nqo
    486494          CLOSE(90) 
    487        ELSE  !! if traceur.def doesn't exist
    488           tnom_0(1)='H2Ov'
    489           tnom_transp(1) = 'air'
    490           tnom_0(2)='H2Ol'
    491           tnom_transp(2) = 'air'
    492           hadv(1) = 10
    493           hadv(2) = 10
    494           vadv(1) = 10
    495           vadv(2) = 10
    496        ENDIF
     495
    497496 
    498497#ifdef INCA
    … …  
    500499            hadv_inca, &
    501500            vadv_inca, &
    502             conv_flg, &
    503             pbl_flg,  &
    504             solsym)
     501            conv_flg_inca, &
     502            pbl_flg_inca,  &
     503            solsym_inca)
     504
     505       conv_flg(1+nqCO2:nbtr) = conv_flg_inca
     506       pbl_flg(1+nqCO2:nbtr) = pbl_flg_inca
     507       solsym(1+nqCO2:nbtr) = solsym_inca
     508
     509       IF (type_trac == 'inco') THEN
     510          conv_flg(1:nqCO2) = 1
     511          pbl_flg(1:nqCO2) = 1
     512          solsym(1:nqCO2) = 'CO2'
     513       ENDIF
    505514#endif
    506515
    507 
    508516!jyg<
    509        DO iq = nqo+1, nqtrue
    510           hadv(iq) = hadv_inca(iq-nqo)
    511           vadv(iq) = vadv_inca(iq-nqo)
    512           tnom_0(iq)=solsym(iq-nqo)
     517       DO iq = nqo+nqCO2+1, nqtrue
     518          hadv(iq) = hadv_inca(iq-nqo-nqCO2)
     519          vadv(iq) = vadv_inca(iq-nqo-nqCO2)
     520          tnom_0(iq)=solsym_inca(iq-nqo-nqCO2)
    513521          tnom_transp(iq) = 'air'
    514522       END DO
    515523
    516     END IF ! (type_trac == 'inca')
     524    ENDIF ! (type_trac == 'inca' or 'inco')
    517525
    518526!-----------------------------------------------------------------------
    … …  
    534542          WRITE(lunout,*) trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
    535543          CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1)
    536        END IF
     544       ENDIF
    537545    END DO
    538546   
    … …  
    550558       ! The true number of tracers is also the total number
    551559       nqtot = nqtrue
    552     END IF
     560    ENDIF
    553561
    554562!
    … …  
    576584
    577585          CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1)
    578        END IF
     586       ENDIF
    579587     
    580588       str1=tnom_0(iq)
    … …  
    584592       ELSE
    585593          ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq))
    586        END IF
     594       ENDIF
    587595
    588596       ! schemas tenant compte des moments d'ordre superieur
    … …  
    602610             tname(new_iq)=trim(str1)//txtp(jq)
    603611          END DO
    604        END IF
     612       ENDIF
    605613    END DO
    606614
    … …  
    621629    WRITE(lunout,*) trim(modname),': Information stored in infotrac :'
    622630    WRITE(lunout,*) trim(modname),': iadv  niadv tname  ttext :'
     631
    623632    DO iq=1,nqtot
    624        WRITE(lunout,*) iadv(iq),niadv(iq),&
    625        ' ',trim(tname(iq)),' ',trim(ttext(iq))
     633       WRITE(lunout,*) iadv(iq),niadv(iq), ' ',trim(tname(iq)),' ',trim(ttext(iq))
    626634    END DO
    627635
    … …  
    637645          WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
    638646          CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
    639        END IF
     647       ENDIF
    640648    END DO
    641649
    642650
    643 ! CRisi: quels sont les traceurs fils et les traceurs pères.
    644 ! initialiser tous les tableaux d'indices liés aux traceurs familiaux
    645 ! + vérifier que tous les pères sont écrits en premières positions
     651! CRisi: quels sont les traceurs fils et les traceurs peres.
     652! initialiser tous les tableaux d'indices lies aux traceurs familiaux
     653! + verifier que tous les peres sont ecrits en premieres positions
    646654    ALLOCATE(nqfils(nqtot),nqdesc(nqtot))   
    647655    ALLOCATE(iqfils(nqtot,nqtot))   
    … …  
    655663    DO iq=1,nqtot
    656664      if (tnom_transp(iq) == 'air') then
    657         ! ceci est un traceur père
     665        ! ceci est un traceur pere
    658666        WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un pere'
    659667        nqperes=nqperes+1
    660668        iqpere(iq)=0
    661669      else !if (tnom_transp(iq) == 'air') then
    662         ! ceci est un fils. Qui est son père?
     670        ! ceci est un fils. Qui est son pere?
    663671        WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un fils'
    664672        continu=.true.
    … …  
    666674        do while (continu)           
    667675          if (tnom_transp(iq) == tnom_0(ipere)) then
    668             ! Son père est ipere
     676            ! Son pere est ipere
    669677            WRITE(lunout,*) 'Le traceur',iq,'appele ', &
    670678      &          trim(tnom_0(iq)),' est le fils de ',ipere,'appele ',trim(tnom_0(ipere))
     679            if (iq.eq.ipere) then
     680                CALL abort_gcm('infotrac_init','Un fils est son propre pere',1)
     681            endif
    671682            nqfils(ipere)=nqfils(ipere)+1 
    672683            iqfils(nqfils(ipere),ipere)=iq
    … …  
    689700    WRITE(lunout,*) 'iqfils=',iqfils
    690701
    691 ! Calculer le nombre de descendants à partir de iqfils et de nbfils
     702! Calculer le nombre de descendants a partir de iqfils et de nbfils
    692703    DO iq=1,nqtot   
    693704      generation=0
    … …  
    712723    WRITE(lunout,*) 'nqdesc_tot=',nqdesc_tot
    713724
    714 ! Interdire autres schémas que 10 pour les traceurs fils, et autres schémas
    715 ! que 10 et 14 si des pères ont des fils
     725! Interdire autres schemas que 10 pour les traceurs fils, et autres schemas
     726! que 10 et 14 si des peres ont des fils
    716727    do iq=1,nqtot
    717728      if (iqpere(iq).gt.0) then
    718         ! ce traceur a un père qui n'est pas l'air
    719         ! Seul le schéma 10 est autorisé
     729        ! ce traceur a un pere qui n'est pas l'air
     730        ! Seul le schema 10 est autorise
    720731        if (iadv(iq)/=10) then
    721732           WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for sons'
    722733          CALL abort_gcm('infotrac_init','Sons should be advected by scheme 10',1)
    723734        endif
    724         ! Le traceur père ne peut être advecté que par schéma 10 ou 14:
     735        ! Le traceur pere ne peut etre advecte que par schema 10 ou 14:
    725736        IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN
    726737          WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for fathers'
    … …  
    730741    enddo !do iq=1,nqtot
    731742
    732     WRITE(lunout,*) 'infotrac init fin'
     743
    733744
    734745! detecter quels sont les traceurs isotopiques parmi des traceurs
    735746    call infotrac_isoinit(tnom_0,nqtrue)
    736        
     747
     748!    if (ntraciso.gt.0) then
     749! le 18 sep 2020: on enleve la condition ntraciso.gt.0 car nqtottr doit etre
     750! connu meme si il n'y a pas d'isotopes!
     751        write(lunout,*) 'infotrac 702: nbtr,ntraciso=',nbtr,ntraciso
     752! retrancher les traceurs isotopiques de la liste des traceurs qui passent dans
     753! phytrac
     754        nbtr=nbtr-nqo*ntraciso
     755
     756! faire un tableau d'indice des traceurs qui passeront dans phytrac
     757        nqtottr=nqtot-nqo*(1+ntraciso)
     758        write(lunout,*) 'infotrac 704: nqtottr,nqtot,nqo=',nqtottr,nqtot,nqo
     759        ! Rq: nqtottr n'est pas forcement egal a nbtr dans le cas ou new_iq /= nqtrue
     760        ALLOCATE (itr_indice(nqtottr)) 
     761        itr_indice(:)=0 
     762        itr=0
     763        do iq=nqo+1, nqtot
     764          if (iso_num(iq).eq.0) then
     765            itr=itr+1
     766            write(*,*) 'itr=',itr
     767            itr_indice(itr)=iq
     768          endif !if (iso_num(iq).eq.0) then
     769        enddo
     770        if (itr.ne.nqtottr) then
     771            CALL abort_gcm('infotrac_init','pb dans le calcul de nqtottr',1)
     772        endif
     773        write(lunout,*) 'itr_indice=',itr_indice
     774!    endif !if (ntraciso.gt.0) then
     775
    737776!-----------------------------------------------------------------------
    738777! Finalize :
    … …  
    740779    DEALLOCATE(tnom_0, hadv, vadv,tnom_transp)
    741780
     781    WRITE(lunout,*) 'infotrac init fin'
    742782
    743783  END SUBROUTINE infotrac_init
    … …  
    754794 
    755795    ! inputs
    756     INTEGER nqtrue
    757     CHARACTER(len=15) tnom_0(nqtrue)
     796    INTEGER,INTENT(IN) :: nqtrue
     797    CHARACTER(len=*),INTENT(IN) :: tnom_0(nqtrue)
    758798   
    759799    ! locals   
    … …  
    762802    INTEGER, ALLOCATABLE,DIMENSION(:) :: nb_isoind
    763803    INTEGER :: ntraceurs_zone_prec,iq,phase,ixt,iiso,izone
    764     CHARACTER(len=19) :: tnom_trac
     804    CHARACTER(len=tname_lenmax) :: tnom_trac
    765805    INCLUDE "iniprint.h"
    766806
    … …  
    838878
    839879        if (nb_iso(ixt,1).eq.1) then
    840           ! on vérifie que toutes les phases ont le même nombre de
     880          ! on verifie que toutes les phases ont le meme nombre de
    841881          ! traceurs
    842882          do phase=2,nqo
    … …  
    851891          ntraceurs_zone=nb_traciso(ixt,1)
    852892
    853           ! on vérifie que toutes les phases ont le même nombre de
     893          ! on verifie que toutes les phases ont le meme nombre de
    854894          ! traceurs
    855895          do phase=2,nqo
    … …  
    860900            endif 
    861901          enddo  !do phase=2,nqo
    862           ! on vérifie que tous les isotopes ont le même nombre de
     902          ! on verifie que tous les isotopes ont le meme nombre de
    863903          ! traceurs
    864904          if (ntraceurs_zone_prec.gt.0) then               
Note: See TracChangeset for help on using the changeset viewer.