Ignore:
Timestamp:
Sep 23, 2024, 4:45:12 PM (6 hours ago)
Author:
abarral
Message:

Merge r5200

Location:
LMDZ6/branches/Amaury_dev
Files:
11 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/iniacademic.F90

    r5221 r5223  
    7676
    7777  REAL zdtvr, tnat, alpha_ideal
    78   LOGICAL, PARAMETER :: tnat1 = .TRUE.
    79 
    80   CHARACTER(LEN = *), parameter :: modname = "iniacademic"
    81   CHARACTER(LEN = 80) :: abort_message
     78  LOGICAL :: ltnat1
     79 
     80  character(len=*),parameter :: modname="iniacademic"
     81  character(len=80) :: abort_message
    8282
    8383  ! Sanity check: verify that options selected by user are not incompatible
    … …  
    305305      ! bulk initialization of tracers
    306306      IF (planet_type=="earth") THEN
    307         ! Earth: first two tracers will be water
     307        ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1)! Earth: first two tracers will be water
    308308        DO iq = 1, nqtot
    309309          q(:, :, iq) = 0.
    … …  
    311311          IF(tracers(iq)%name == addPhase('H2O', 'l')) q(:, :, iq) = 1.e-15
    312312
    313           ! CRisi: init des isotopes
    314           ! distill de Rayleigh très simplifiée
    315           iName = tracers(iq)%iso_iName
    316           IF (niso <= 0 .OR. iName <= 0) CYCLE
    317           iPhase = tracers(iq)%iso_iPhase
    318           iqParent = tracers(iq)%iqParent
    319           IF(tracers(iq)%iso_iZone == 0) THEN
    320             IF (tnat1) THEN
    321               tnat = 1.0
    322               alpha_ideal = 1.0
    323               WRITE(*, *) 'Attention dans iniacademic: alpha_ideal=1'
    324             else
    325               IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
    326                       CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
    327             endif
    328             q(:, :, iq) = q(:, :, iqParent) * tnat * (q(:, :, iqParent) / 30.e-3)**(alpha_ideal - 1.)
    329           ELSE !IF(tracers(iq)%iso_iZone == 0) THEN
    330             IF(tracers(iq)%iso_iZone == 1) THEN
    331               ! correction le 14 mai 2024 pour que tous les traceurs soient de la couleur 1.
    332               ! Sinon, on va avoir des porblèmes de conservation de masse de traceurs.
    333               q(:, :, iq) = q(:, :, iqIsoPha(iName, iPhase))
    334             else !IF(tracers(iq)%iso_iZone == 1) THEN
    335               q(:, :, iq) = 0.
    336             endif !IF(tracers(iq)%iso_iZone == 1) THEN
    337           END IF !IF(tracers(iq)%iso_iZone == 0) THEN
    338         enddo
    339       else
    340         q(:, :, :) = 0
    341       endif ! of if (planet_type=="earth")
     313              ! CRisi: init des isotopes
     314              ! distill de Rayleigh très simplifiée
     315              iName    = tracers(iq)%iso_iName
     316              if (niso <= 0 .OR. iName <= 0) CYCLE
     317              iPhase  = tracers(iq)%iso_iPhase
     318              iqParent = tracers(iq)%iqParent
     319              IF(tracers(iq)%iso_iZone == 0) THEN
     320                 IF(ltnat1) THEN
     321                    tnat = 1.0
     322                    alpha_ideal = 1.0
     323                    WRITE(lunout, *)'In '//TRIM(modname)//': !!!  Beware: alpha_ideal put to 1  !!!'
     324                 ELSE
     325                    IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
     326                    CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
     327                 END IF
     328                 q(:,:,iq) = q(:,:,iqParent)*tnat*(q(:,:,iqParent)/30.e-3)**(alpha_ideal-1.)
     329              ELSE !IF(tracers(iq)%iso_iZone == 0) THEN
     330                 IF(tracers(iq)%iso_iZone == 1) THEN
     331                    ! correction le 14 mai 2024 pour que tous les traceurs soient de la couleur 1.
     332                    ! Sinon, on va avoir des porblèmes de conservation de masse de traceurs.
     333                    q(:,:,iq) = q(:,:,iqIsoPha(iName,iPhase))
     334                 else !IF(tracers(iq)%iso_iZone == 1) THEN
     335                    q(:,:,iq) = 0.
     336                 endif !IF(tracers(iq)%iso_iZone == 1) THEN
     337              END IF !IF(tracers(iq)%iso_iZone == 0) THEN
     338           enddo
     339        else
     340           q(:,:,:)=0
     341        endif ! of if (planet_type=="earth")
    342342
    343343      CALL check_isotopes_seq(q, ip1jmp1, 'iniacademic_loc')

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/lmdz_check_isotopes.f90

    r5186 r5223  
    2929            deltaDmin = -999.0, &
    3030            ridicule = 1e-12
    31     INTEGER, SAVE :: iso_eau, iso_HDO, iso_O18, &
    32             iso_O17, iso_HTO
    33     LOGICAL, SAVE :: first = .TRUE.
    34     LOGICAL, PARAMETER :: tnat1 = .TRUE.
     31    INTEGER, SAVE :: iso_eau, iso_O17, iso_O18, iso_HDO, iso_HTO
     32    LOGICAL, SAVE :: ltnat1, first = .TRUE.
    3533
    3634    modname = 'check_isotopes'
    … …  
    3937    IF(niso == 0)        RETURN                   !--- No isotopes => finished
    4038    IF(first) THEN
     39      ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1)
     40      ALLOCATE(tnat(niso))
    4141      iso_eau = strIdx(isoName, 'H216O')
     42      iso_O17 = strIdx(isoName, 'H217O')
     43      iso_O18 = strIdx(isoName, 'H218O')
    4244      iso_HDO = strIdx(isoName, 'HDO')
    43       iso_O18 = strIdx(isoName, 'H218O')
    44       iso_O17 = strIdx(isoName, 'H217O')
    4545      iso_HTO = strIdx(isoName, 'HTO')
    46       IF (tnat1) THEN
     46      IF(ltnat1) THEN
    4747        tnat(:) = 1.0
    48       else
     48      ELSE
    4949        IF(getKey('tnat', tnat)) CALL abort_gcm(modname, 'missing isotopic parameter', 1)
    50       endif
     50      END IF
    5151      first = .FALSE.
    5252    END IF
    … …  
    6060        DO k = 1, llm
    6161          DO i = 1, ip1jmp1
    62             IF(ABS(q(i, k, iq)) < borne) CYCLE
     62            IF(ABS(q(i, k, iq)) <= borne) CYCLE
    6363            WRITE(msg1, '(s,"(",i0,",",i0,",",i0,") = ",ES12.4)')TRIM(isoName(ixt)), i, k, iq, q(i, k, iq)
    6464            CALL msg(msg1, modname)

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/lmdz_dynetat0.f90

    r5222 r5223  
    1212    !-------------------------------------------------------------------------------
    1313    USE lmdz_infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName, &
    14                          new2oldH2O, newHNO3, oldHNO3, getKey
     14            new2oldH2O, newHNO3, oldHNO3, getKey
    1515    USE lmdz_strings, ONLY: maxlen, msg, strStack, real2str, int2str
    1616    USE netcdf, ONLY: nf90_open, nf90_nowrite, nf90_inq_varid, nf90_close, nf90_get_var, nf90_noerr
    … …  
    4949    INTEGER :: iq, fID, vID, idecal, iqParent, iName, iZone, iPhase, ix
    5050    REAL :: time, tnat, alpha_ideal, tab_cntrl(length)    !--- RUN PARAMS TABLE
    51     LOGICAL :: lSkip, ll
    52     LOGICAL, PARAMETER :: tnat1 = .TRUE.
     51    LOGICAL :: lSkip, ll, ltnat1
    5352    !-------------------------------------------------------------------------------
    5453    modname = "dynetat0"
    … …  
    140139      ll = nf90_inq_varid(fID, 'HNO3tot', vID) /= nf90_noerr                                 !--- DETECT OLD REPRO start.nc FILE
    141140    END IF
     141    ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1)
    142142    DO iq = 1, nqtot
    143143      var = tracers(iq)%name
    … …  
    163163        iqParent = tracers(iq)%iqParent
    164164        IF(tracers(iq)%iso_iZone == 0) THEN
    165           IF (tnat1) THEN
     165          IF(ltnat1) THEN
    166166            tnat = 1.0
    167167            alpha_ideal = 1.0
    168             WRITE(*, *) 'attention dans dynetat0: les alpha_ideal sont a 1'
    169           else
     168            CALL msg(' !!!  Beware: alpha_ideal put to 1  !!!', modname)
     169          ELSE
    170170            IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
    171171                    CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
    172           endif
     172          END IF
    173173          CALL msg('Missing tracer <' // TRIM(var) // '> => initialized with a simplified Rayleigh distillation law.', modname)
    174174          q(:, :, :, iq) = q(:, :, :, iqParent) * tnat * (q(:, :, :, iqParent) / 30.e-3)**(alpha_ideal - 1.)

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iso_verif_dyn.f90

    r5182 r5223  
    1   function iso_verif_noNaN_nostop(x,err_msg)
    2     IMPLICIT NONE
    3     ! si x est NaN, on affiche message
    4     ! d'erreur et return 1 si erreur
     1function iso_verif_noNaN_nostop(x, err_msg)
     2  IMPLICIT NONE
     3  ! si x est NaN, on affiche message
     4  ! d'erreur et return 1 si erreur
    55
    6     ! input:
    7     REAL :: x
    8     CHARACTER(LEN=*) :: err_msg ! message d''erreur à afficher
     6  ! input:
     7  REAL :: x
     8  CHARACTER(LEN = *) :: err_msg ! message d''erreur à afficher
    99
    10     ! output
    11     REAL :: borne
    12     parameter (borne=1e19)
    13     INTEGER :: iso_verif_noNaN_nostop
     10  ! output
     11  REAL :: borne
     12  parameter (borne = 1e19)
     13  INTEGER :: iso_verif_noNaN_nostop
    1414
    15     IF ((x>-borne).AND.(x<borne)) THEN
    16             iso_verif_noNAN_nostop=0
    17     else
    18         WRITE(*,*) 'erreur detectee par iso_verif_nonNaN:'
    19         WRITE(*,*) err_msg
    20         WRITE(*,*) 'x=',x
    21         iso_verif_noNaN_nostop=1
    22     endif
     15  IF ((x>-borne).AND.(x<borne)) THEN
     16    iso_verif_noNAN_nostop = 0
     17  else
     18    WRITE(*, *) 'erreur detectee par iso_verif_nonNaN:'
     19    WRITE(*, *) err_msg
     20    WRITE(*, *) 'x=', x
     21    iso_verif_noNaN_nostop = 1
     22  endif
    2323
    24     RETURN
     24  RETURN
    2525END FUNCTION iso_verif_nonan_nostop
    2626
    27   function iso_verif_egalite_nostop &
    28           (a,b,err_msg)
    29     IMPLICIT NONE
    30     ! compare a et b. Si pas egal, on affiche message
    31     ! d'erreur et stoppe
    32     ! pour egalite, on verifie erreur absolue et arreur relative
     27function iso_verif_egalite_nostop &
     28        (a, b, err_msg)
     29  IMPLICIT NONE
     30  ! compare a et b. Si pas egal, on affiche message
     31  ! d'erreur et stoppe
     32  ! pour egalite, on verifie erreur absolue et arreur relative
    3333
    34     ! input:
    35     REAL :: a, b
    36     CHARACTER(LEN=*) :: err_msg ! message d''erreur à afficher
     34  ! input:
     35  REAL :: a, b
     36  CHARACTER(LEN = *) :: err_msg ! message d''erreur à afficher
    3737
    38     ! locals
    39     REAL :: errmax ! erreur maximale en absolu.
    40     REAL :: errmaxrel ! erreur maximale en relatif autorisée
    41     parameter (errmax=1e-8)
    42     parameter (errmaxrel=1e-3)
     38  ! locals
     39  REAL :: errmax ! erreur maximale en absolu.
     40  REAL :: errmaxrel ! erreur maximale en relatif autorisée
     41  parameter (errmax = 1e-8)
     42  parameter (errmaxrel = 1e-3)
    4343
    44     ! output
    45     INTEGER :: iso_verif_egalite_nostop
     44  ! output
     45  INTEGER :: iso_verif_egalite_nostop
    4646
    47     iso_verif_egalite_nostop=0
     47  iso_verif_egalite_nostop = 0
    4848
    49     IF (abs(a-b)>errmax) THEN
    50       IF (abs((a-b)/max(max(abs(b),abs(a)),1e-18)) &
     49  IF (abs(a - b)>errmax) THEN
     50    IF (abs((a - b) / max(max(abs(b), abs(a)), 1e-18)) &
    5151            >errmaxrel) THEN
    52         WRITE(*,*) 'erreur detectee par iso_verif_egalite:'
    53         WRITE(*,*) err_msg
    54         WRITE(*,*) 'a=',a
    55         WRITE(*,*) 'b=',b
    56         iso_verif_egalite_nostop=1
    57       endif
     52      WRITE(*, *) 'erreur detectee par iso_verif_egalite:'
     53      WRITE(*, *) err_msg
     54      WRITE(*, *) 'a=', a
     55      WRITE(*, *) 'b=', b
     56      iso_verif_egalite_nostop = 1
    5857    endif
     58  endif
    5959
    60     RETURN
     60  RETURN
    6161END FUNCTION iso_verif_egalite_nostop
    6262
    6363
    64   function iso_verif_aberrant_nostop &
    65           (x,iso,q,err_msg)
    66     USE lmdz_infotrac, ONLY: isoName, getKey
    67     IMPLICIT NONE
     64function iso_verif_aberrant_nostop &
     65        (x, iso, q, err_msg)
     66  USE lmdz_infotrac, ONLY: isoName, getKey
     67  IMPLICIT NONE
    6868
    69     ! input:
    70     REAL :: x,q
    71     INTEGER :: iso ! 2=HDO, 1=O18
    72     CHARACTER(LEN=*) :: err_msg ! message d''erreur à afficher
     69  ! input:
     70  REAL :: x, q
     71  INTEGER :: iso ! 2=HDO, 1=O18
     72  CHARACTER(LEN = *) :: err_msg ! message d''erreur à afficher
    7373
    74     ! locals
    75     REAL :: qmin,deltaD
    76     REAL :: deltaDmax,deltaDmin,tnat
    77     parameter (qmin=1e-11)
    78     parameter (deltaDmax=200.0,deltaDmin=-999.9)
     74  ! locals
     75  REAL :: qmin, deltaD
     76  REAL :: deltaDmax, deltaDmin, tnat
     77  parameter (qmin = 1e-11)
     78  parameter (deltaDmax = 200.0, deltaDmin = -999.9)
     79  LOGICAL, SAVE :: ltnat1
     80  LOGICAL, SAVE :: lFirst = .TRUE.
    7981
    80     ! output
    81     INTEGER :: iso_verif_aberrant_nostop
     82  ! output
     83  INTEGER :: iso_verif_aberrant_nostop
    8284
    83     iso_verif_aberrant_nostop=0
     85  IF(lFirst) THEN
     86    ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1)
     87    lFirst = .FALSE.
     88  END IF
     89  iso_verif_aberrant_nostop = 0
    8490
    85     ! verifier que HDO est raisonable
    86      IF (q>qmin) THEN
    87          IF(getKey('tnat', tnat, isoName(iso))) THEN
    88               err_msg = 'Missing isotopic parameter "tnat"'
    89               iso_verif_aberrant_nostop=1
    90               RETURN
    91          END IF
    92          deltaD=(x/q/tnat-1)*1000
    93          IF ((deltaD>deltaDmax).OR.(deltaD<deltaDmin)) THEN
    94               WRITE(*,*) 'erreur detectee par iso_verif_aberrant:'
    95               WRITE(*,*) err_msg
    96               WRITE(*,*) 'q=',q
    97               WRITE(*,*) 'deltaD=',deltaD
    98               WRITE(*,*) 'iso=',iso
    99               iso_verif_aberrant_nostop=1
    100          endif !if ((deltaD.gt.deltaDmax).OR.(deltaD.lt.deltaDmin)) THEN
    101       endif !if (q(i,k,iq).gt.qmin) THEN
    102     RETURN
     91  ! verifier que HDO est raisonable
     92  IF (q>qmin) THEN
     93    IF(ltnat1) THEN
     94      tnat = 1.0
     95    ELSE IF(getKey('tnat', tnat, isoName(iso))) THEN
     96      err_msg = 'Missing isotopic parameter "tnat"'
     97      iso_verif_aberrant_nostop = 1
     98      RETURN
     99    END IF
     100    deltaD = (x / q / tnat - 1) * 1000
     101    IF ((deltaD>deltaDmax).OR.(deltaD<deltaDmin)) THEN
     102      WRITE(*, *) 'erreur detectee par iso_verif_aberrant:'
     103      WRITE(*, *) err_msg
     104      WRITE(*, *) 'q=', q
     105      WRITE(*, *) 'deltaD=', deltaD
     106      WRITE(*, *) 'iso=', iso
     107      iso_verif_aberrant_nostop = 1
     108    endif !if ((deltaD.gt.deltaDmax).OR.(deltaD.lt.deltaDmin)) THEN
     109  endif !if (q(i,k,iq).gt.qmin) THEN
     110  RETURN
    103111END FUNCTION iso_verif_aberrant_nostop
    104112

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/check_isotopes_loc.F90

    r5182 r5223  
    2424                      deltaDmin =-999.0, &
    2525                      ridicule  = 1e-12
    26    INTEGER, SAVE :: iso_eau, iso_HDO, iso_O18, & !--- OpenMP shared variables
    27                              iso_O17, iso_HTO
     26   INTEGER, SAVE :: iso_eau, iso_HDO, iso_O18, iso_O17, iso_HTO
     27!$OMP THREADPRIVATE(iso_eau, iso_HDO, iso_O18, iso_O17, iso_HTO)
     28   LOGICAL       :: ltnat1
    2829   LOGICAL, SAVE :: first=.TRUE.
    29    LOGICAL, PARAMETER :: tnat1=.TRUE.
    3030!$OMP THREADPRIVATE(first)
    3131
    … …  
    3636   IF(first) THEN
    3737!$OMP MASTER
     38      ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1)
     39      ALLOCATE(tnat(niso))
    3840      iso_eau = strIdx(isoName,'H216O')
     41      iso_O17 = strIdx(isoName,'H217O')
     42      iso_O18 = strIdx(isoName,'H218O')
    3943      iso_HDO = strIdx(isoName,'HDO')
    40       iso_O18 = strIdx(isoName,'H218O')
    41       iso_O17 = strIdx(isoName,'H217O')
    4244      iso_HTO = strIdx(isoName,'HTO')
    43       IF (tnat1) THEN
    44               tnat(:)=1.0
    45       else
     45      IF(ltnat1) THEN
     46         tnat(:)=1.0
     47      ELSE
    4648         IF(getKey('tnat', tnat)) CALL abort_gcm(modname, 'missing isotopic parameter', 1)
    47       endif
     49      END IF
    4850!$OMP END MASTER
    4951!$OMP BARRIER
    … …  
    6062         DO k = 1, llm
    6163            DO i = ijb, ije
    62                IF(ABS(q(i,k,iq))<=borne) CYCLE
     64               IF(ABS(q(i,k,iq)) <= borne) CYCLE
    6365               WRITE(msg1,'(s,"(",i0,",",i0,",",i0,") = ",ES12.4)')TRIM(isoName(ixt)),i,k,iq,q(i,k,iq)
    6466               CALL msg(msg1, modname)

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynetat0_loc.f90

    r5222 r5223  
    88  USE parallel_lmdz
    99  USE lmdz_infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName, &
    10                          new2oldH2O, newHNO3, oldHNO3, getKey
     10          new2oldH2O, newHNO3, oldHNO3, getKey
    1111  USE lmdz_strings, ONLY: maxlen, msg, strStack, real2str, int2str, strIdx
    1212  USE netcdf, ONLY: nf90_open, nf90_nowrite, nf90_inquire_dimension, nf90_inq_varid, &
    … …  
    4949  REAL, ALLOCATABLE :: ucov_glo(:, :), q_glo(:, :), phis_glo(:)
    5050  REAL, ALLOCATABLE :: teta_glo(:, :)
    51   LOGICAL :: lSkip, ll
    52   LOGICAL, PARAMETER :: tnat1 = .TRUE.
     51  LOGICAL :: lSkip, ll, ltnat1
    5352  !-------------------------------------------------------------------------------
    5453  modname = "dynetat0_loc"
    … …  
    160159    ll = nf90_inq_varid(fID, 'HNO3tot', vID) /= nf90_noerr                                 !--- DETECT OLD REPRO start.nc FILE
    161160  END IF
     161  ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1)
    162162  DO iq = 1, nqtot
    163163    var = tracers(iq)%name
    … …  
    175175      !--------------------------------------------------------------------------------------------------------------------------
    176176    ELSE IF(nf90_inq_varid(fID, oldVar, vID) == nf90_noerr) THEN                         !=== TRY WITH ALTERNATE NAME
    177       CALL msg('Missing tracer <'//TRIM(var)//'> => initialized to <' // TRIM(oldVar) // '>', modname)
     177      CALL msg('Missing tracer <' // TRIM(var) // '> => initialized to <' // TRIM(oldVar) // '>', modname)
    178178      CALL get_var2(oldVar, q_glo); q(ijb_u:ije_u, :, iq) = q_glo(ijb_u:ije_u, :)
    179179      !--------------------------------------------------------------------------------------------------------------------------
    … …  
    183183      iqParent = tracers(iq)%iqParent
    184184      IF(tracers(iq)%iso_iZone == 0) THEN
    185         IF (tnat1) THEN
     185        IF(ltnat1) THEN
    186186          tnat = 1.0
    187187          alpha_ideal = 1.0
    188           WRITE(*, *) 'attention dans dynetat0: les alpha_ideal sont a 1'
    189         else
     188          CALL msg(' !!!  Beware: alpha_ideal put to 1  !!!', modname)
     189        ELSE
    190190          IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
    191191                  CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
    192         endif
    193         CALL msg('Missing tracer <'//TRIM(var)//'> => initialized with a simplified Rayleigh distillation law.', modname)
     192        END IF
     193        CALL msg('Missing tracer <' // TRIM(var) // '> => initialized with a simplified Rayleigh distillation law.', modname)
    194194        q(ijb_u:ije_u, :, iq) = q(ijb_u:ije_u, :, iqParent) * tnat * (q(ijb_u:ije_u, :, iqParent) / 30.e-3)**(alpha_ideal - 1.)
    195195        ! Camille 9 mars 2023: point de vigilence: initialisation incohérente
    196196        ! avec celle de xt_ancien dans la physiq.
    197197      ELSE
    198         CALL msg('Missing tracer <'//TRIM(var)//'> => initialized to its parent isotope concentration.', modname)
     198        CALL msg('Missing tracer <' // TRIM(var) // '> => initialized to its parent isotope concentration.', modname)
    199199        ! Camille 9 mars 2023: attention!! seuls les tags qui correspondent à
    200200        ! izone=izone_init (définie dans isotrac_mod) sont initialisés comme
    … …  
    210210      !--------------------------------------------------------------------------------------------------------------------------
    211211    ELSE                                                                                 !=== MISSING: SET TO 0
    212       CALL msg('Missing tracer <'//TRIM(var)//'> => initialized to zero', modname)
     212      CALL msg('Missing tracer <' // TRIM(var) // '> => initialized to zero', modname)
    213213      q(ijb_u:ije_u, :, iq) = 0.
    214214      !--------------------------------------------------------------------------------------------------------------------------

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/iniacademic_loc.F90

    r5221 r5223  
    7878
    7979  REAL zdtvr, tnat, alpha_ideal
    80   LOGICAL, PARAMETER :: tnat1 = .TRUE.
    81 
    82   CHARACTER(LEN = *), parameter :: modname = "iniacademic"
    83   CHARACTER(LEN = 80) :: abort_message
     80  LOGICAL :: ltnat1
     81 
     82  CHARACTER(LEN=*),parameter :: modname="iniacademic"
     83  CHARACTER(LEN=80) :: abort_message
    8484
    8585  ! Sanity check: verify that options selected by user are not incompatible
    … …  
    304304      ! bulk initialization of tracers
    305305      IF (planet_type=="earth") THEN
    306         ! Earth: first two tracers will be water
     306        ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1)! Earth: first two tracers will be water
    307307        DO iq = 1, nqtot
    308308          q(ijb_u:ije_u, :, iq) = 0.
    … …  
    310310          IF(tracers(iq)%name == addPhase('H2O', 'l')) q(ijb_u:ije_u, :, iq) = 1.e-15
    311311
    312           ! CRisi: init des isotopes
    313           ! distill de Rayleigh très simplifiée
    314           iName = tracers(iq)%iso_iName
    315           IF (niso <= 0 .OR. iName <= 0) CYCLE
    316           iPhase = tracers(iq)%iso_iPhase
    317           iqParent = tracers(iq)%iqParent
    318           IF(tracers(iq)%iso_iZone == 0) THEN
    319             IF (tnat1) THEN
    320               tnat = 1.0
    321               alpha_ideal = 1.0
    322               WRITE(*, *) 'Attention dans iniacademic: alpha_ideal=1'
    323             else
    324               IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
    325                       CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
    326             endif
    327             q(ijb_u:ije_u, :, iq) = q(ijb_u:ije_u, :, iqParent) * tnat * (q(ijb_u:ije_u, :, iqParent) / 30.e-3)**(alpha_ideal - 1.)
    328           ELSE !IF(tracers(iq)%iso_iZone == 0) THEN
    329             IF(tracers(iq)%iso_iZone == 1) THEN ! a verifier.
    330               ! correction le 14 mai 2024 pour que tous les traceurs soient de la couleur 1.
    331               ! Sinon, on va avoir des porblèmes de conservation de masse de traceurs.
    332               q(ijb_u:ije_u, :, iq) = q(ijb_u:ije_u, :, iqIsoPha(iName, iPhase))
    333             else !IF(tracers(iq)%iso_iZone == 1) THEN
    334               q(ijb_u:ije_u, :, iq) = 0.0
    335             endif !IF(tracers(iq)%iso_iZone == 1) THEN
    336           END IF !IF(tracers(iq)%iso_iZone == 0) THEN
    337         enddo
    338       else
    339         q(ijb_u:ije_u, :, :) = 0
    340       endif ! of if (planet_type=="earth")
     312              ! CRisi: init des isotopes
     313              ! distill de Rayleigh très simplifiée
     314              iName    = tracers(iq)%iso_iName
     315              if (niso <= 0 .OR. iName <= 0) CYCLE
     316              iPhase  = tracers(iq)%iso_iPhase
     317              iqParent = tracers(iq)%iqParent
     318              IF(tracers(iq)%iso_iZone == 0) THEN
     319                 IF(ltnat1) THEN
     320                    tnat = 1.0
     321                    alpha_ideal = 1.0
     322                    WRITE(lunout, *) 'In '//TRIM(modname)//': !!!  Beware: alpha_ideal put to 1  !!!'
     323                 ELSE
     324                    IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
     325                    CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
     326                 END IF
     327                 q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqParent)*tnat*(q(ijb_u:ije_u,:,iqParent)/30.e-3)**(alpha_ideal-1.)
     328              ELSE !IF(tracers(iq)%iso_iZone == 0) THEN
     329                 IF(tracers(iq)%iso_iZone == 1) THEN ! a verifier.
     330                    ! correction le 14 mai 2024 pour que tous les traceurs soient de la couleur 1.
     331                    ! Sinon, on va avoir des porblèmes de conservation de masse de traceurs.
     332                    q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase))
     333                 else !IF(tracers(iq)%iso_iZone == 1) THEN
     334                    q(ijb_u:ije_u,:,iq) = 0.0
     335                 endif !IF(tracers(iq)%iso_iZone == 1) THEN
     336              END IF !IF(tracers(iq)%iso_iZone == 0) THEN
     337           enddo
     338        else
     339           q(ijb_u:ije_u,:,:)=0
     340        endif ! of if (planet_type=="earth")
    341341
    342342      CALL check_isotopes(q, ijb_u, ije_u, 'iniacademic_loc')

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/qminimum_loc.f90

    r5222 r5223  
    77  USE lmdz_strings, ONLY: strIdx
    88  USE lmdz_iniprint, ONLY: lunout, prt_level
    9 
    109
    1110  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm

  • LMDZ6/branches/Amaury_dev/libf/phylmd/infotrac_phy.F90

    r5221 r5223  
    316316    !--- Transfert the number of tracers to Reprobus
    317317    IF (CPPKEY_REPROBUS) THEN
    318       CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)
     318      CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)                         !--- Transfert the number of tracers to Reprobus
    319319    END IF
    320320

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/isotopes_mod.F90

    r5158 r5223  
    160160   !=== Local variables:
    161161   INTEGER :: ixt
    162 
     162   LOGICAL :: ltnat1
     163   CHARACTER(LEN=maxlen) :: modname, sxt
    163164 
    164165   !--- For H2[17]O
    … …  
    169170   LOGICAL, PARAMETER ::   ok_nocinsat = .FALSE. ! if T: no sursaturation effect for ice
    170171   LOGICAL, PARAMETER :: Rdefault_smow = .FALSE. ! if T: Rdefault=smow; if F: nul
    171    LOGICAL, PARAMETER :: tnat1 = .TRUE. ! If T: all tnats are 1.
    172172
    173173   !--- For [3]H
    174174   INTEGER :: iessai
    175 
    176    CHARACTER(LEN=maxlen) :: modname, sxt
    177175
    178176   modname = 'iso_init'
    … …  
    264262   IF(ANY(isoName == 'HTO')) &
    265263   CALL get_in('ok_prod_nucl_tritium', ok_prod_nucl_tritium, .FALSE., .FALSE.)
     264   CALL get_in('tnateq1', ltnat1, .TRUE.)
    266265
    267266   ! Ocean composition
    … …  
    294293       tkcin1(ixt) = 0.0005016
    295294       tkcin2(ixt) = 0.0014432
    296        IF (tnat1) THEN
    297                tnat(ixt)=1
    298        else
    299                tnat(ixt)=0.
    300        endif
     295       tnat(ixt) = 0.0; IF(ltnat1) tnat(ixt)=1
    301296       toce(ixt)=4.0E-19 ! rapport T/H = 0.2 TU Dreisigacker and Roether 1978
    302297       tcorr(ixt)=1.
    … …  
    317312       tkcin1(ixt) = tkcin1_O18*fac_kcin
    318313       tkcin2(ixt) = tkcin2_O18*fac_kcin
    319        IF (tnat1) THEN
    320                tnat(ixt)=1
    321        else
    322                tnat(ixt)=0.004/100. ! O17 représente 0.004% de l'oxygène
    323        endif
     314       tnat(ixt)=0.004/100. ! O17 représente 0.004% de l'oxygène
     315       IF(ltnat1) tnat(ixt)=1
    324316       toce(ixt)=tnat(ixt)*(1.0+deltaO18_oce/1000.0)**pente_MWL
    325317       tcorr(ixt)=1.0+fac_enrichoce18*pente_MWL ! donné par Amaelle           
    … …  
    337329       tkcin1(ixt) = tkcin1_O18
    338330       tkcin2(ixt) = tkcin2_O18
    339        IF (tnat1) THEN
    340                tnat(ixt)=1
    341        else
    342                tnat(ixt)=2005.2E-6
    343        endif
     331       tnat(ixt)=2005.2E-6; IF(ltnat1) tnat(ixt)=1
    344332       toce(ixt)=tnat(ixt)*(1.0+deltaO18_oce/1000.0)
    345333       tcorr(ixt)=1.0+fac_enrichoce18
    … …  
    361349       tkcin1(ixt) = tkcin1_O18*fac_kcin
    362350       tkcin2(ixt) = tkcin2_O18*fac_kcin
    363        IF (tnat1) THEN
    364                tnat(ixt)=1
    365        else
    366                tnat(ixt)=155.76E-6
    367        endif
     351       tnat(ixt)=155.76E-6; IF(ltnat1) tnat(ixt)=1
    368352       toce(ixt)=tnat(ixt)*(1.0+pente_MWL*deltaO18_oce/1000.0)
    369353       tcorr(ixt)=1.0+fac_enrichoce18*pente_MWL         
Note: See TracChangeset for help on using the changeset viewer.