Ignore:
Timestamp:
Sep 11, 2024, 4:27:07 PM (4 months ago)
Author:
abarral
Message:

Replace REPROBUS CPP KEY by logical using handmade wonky wrapper

Location:
LMDZ6/branches/Amaury_dev/libf
Files:
108 edited
9 moved

Legend:

Unmodified
Added
Removed

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

    r5182 r5185  
    200200      END IF
    201201    CASE('repr')
    202       IF (.NOT. CPPKEY_REPROBUS)
     202      IF (.NOT. CPPKEY_REPROBUS) THEN
    203203        CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
    204204      END IF

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

    r5184 r5185  
    1 SUBROUTINE dynetat0_loc(fichnom,vcov,ucov,teta,q,masse,ps,phis,time)
    2 
    3 !-------------------------------------------------------------------------------
    4 ! Authors: P. Le Van , L.Fairhead
    5 !-------------------------------------------------------------------------------
    6 ! Purpose: Initial state reading.
    7 !-------------------------------------------------------------------------------
     1SUBROUTINE dynetat0_loc(fichnom, vcov, ucov, teta, q, masse, ps, phis, time)
     2
     3  !-------------------------------------------------------------------------------
     4  ! Authors: P. Le Van , L.Fairhead
     5  !-------------------------------------------------------------------------------
     6  ! Purpose: Initial state reading.
     7  !-------------------------------------------------------------------------------
    88  USE parallel_lmdz
    9   USE lmdz_infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName
     9  USE lmdz_infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName
    1010  USE lmdz_strings, ONLY: maxlen, msg, strStack, real2str, int2str, strIdx
    11   USE netcdf,      ONLY: nf90_open, nf90_nowrite, nf90_inquire_dimension, nf90_inq_varid, &
    12                          nf90_close, nf90_get_var, nf90_inquire_variable, nf90_noerr
     11  USE netcdf, ONLY: nf90_open, nf90_nowrite, nf90_inquire_dimension, nf90_inq_varid, &
     12          nf90_close, nf90_get_var, nf90_inquire_variable, nf90_noerr
    1313  USE lmdz_readTracFiles, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
    1414  USE control_mod, ONLY: planet_type
    1515  USE lmdz_assert_eq, ONLY: assert_eq
    16   USE comvert_mod, ONLY: pa,preff
     16  USE comvert_mod, ONLY: pa, preff
    1717  USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad
    1818  USE logic_mod, ONLY: fxyhypb, ysinus
    1919  USE serre_mod, ONLY: clon, clat, grossismx, grossismy
    2020  USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time
    21   USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
    22   USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA
     21  USE ener_mod, ONLY: etot0, ptot0, ztot0, stot0, ang0
     22  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS
    2323  USE lmdz_description, ONLY: descript
    2424  USE lmdz_iniprint, ONLY: lunout, prt_level
    2525  USE lmdz_comgeom
    2626
    27 USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     27  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    2828  USE lmdz_paramet
    2929  IMPLICIT NONE
    3030
    3131
    32 !===============================================================================
    33 ! Arguments:
    34   CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
    35   REAL, INTENT(OUT) ::  vcov(ijb_v:ije_v,llm)      !--- V COVARIANT WIND
    36   REAL, INTENT(OUT) ::  ucov(ijb_u:ije_u,llm)      !--- U COVARIANT WIND
    37   REAL, INTENT(OUT) ::  teta(ijb_u:ije_u,llm)      !--- POTENTIAL TEMP.
    38   REAL, INTENT(OUT) ::     q(ijb_u:ije_u,llm,nqtot)!--- TRACERS
    39   REAL, INTENT(OUT) :: masse(ijb_u:ije_u,llm)      !--- MASS PER CELL
    40   REAL, INTENT(OUT) ::    ps(ijb_u:ije_u)          !--- GROUND PRESSURE
    41   REAL, INTENT(OUT) ::  phis(ijb_u:ije_u)          !--- GEOPOTENTIAL
    42 !===============================================================================
    43 ! Local variables:
    44   CHARACTER(LEN=maxlen) :: mesg, var, modname, oldVar
    45   INTEGER, PARAMETER :: length=100
     32  !===============================================================================
     33  ! Arguments:
     34  CHARACTER(LEN = *), INTENT(IN) :: fichnom          !--- FILE NAME
     35  REAL, INTENT(OUT) :: vcov(ijb_v:ije_v, llm)      !--- V COVARIANT WIND
     36  REAL, INTENT(OUT) :: ucov(ijb_u:ije_u, llm)      !--- U COVARIANT WIND
     37  REAL, INTENT(OUT) :: teta(ijb_u:ije_u, llm)      !--- POTENTIAL TEMP.
     38  REAL, INTENT(OUT) :: q(ijb_u:ije_u, llm, nqtot)!--- TRACERS
     39  REAL, INTENT(OUT) :: masse(ijb_u:ije_u, llm)      !--- MASS PER CELL
     40  REAL, INTENT(OUT) :: ps(ijb_u:ije_u)          !--- GROUND PRESSURE
     41  REAL, INTENT(OUT) :: phis(ijb_u:ije_u)          !--- GEOPOTENTIAL
     42  !===============================================================================
     43  ! Local variables:
     44  CHARACTER(LEN = maxlen) :: mesg, var, modname, oldVar
     45  INTEGER, PARAMETER :: length = 100
    4646  INTEGER :: iq, fID, vID, idecal, ierr, iqParent, iName, iZone, iPhase, ix
    47   REAL    :: time,tab_cntrl(length)    !--- RUN PARAMS TABLE
    48   REAL    :: tnat, alpha_ideal
    49   REAL,             ALLOCATABLE :: vcov_glo(:,:),masse_glo(:,:),  ps_glo(:)
    50   REAL,             ALLOCATABLE :: ucov_glo(:,:),    q_glo(:,:), phis_glo(:)
    51   REAL,             ALLOCATABLE :: teta_glo(:,:)
     47  REAL :: time, tab_cntrl(length)    !--- RUN PARAMS TABLE
     48  REAL :: tnat, alpha_ideal
     49  REAL, ALLOCATABLE :: vcov_glo(:, :), masse_glo(:, :), ps_glo(:)
     50  REAL, ALLOCATABLE :: ucov_glo(:, :), q_glo(:, :), phis_glo(:)
     51  REAL, ALLOCATABLE :: teta_glo(:, :)
    5252  LOGICAL :: lSkip, ll
    53   LOGICAL,PARAMETER :: tnat1=.TRUE.
    54 !-------------------------------------------------------------------------------
    55   modname="dynetat0_loc"
    56 
    57 !--- Initial state file opening
    58   var=fichnom
    59   CALL err(nf90_open(var,nf90_nowrite,fID),"open",var)
    60   CALL get_var1("controle",tab_cntrl)
    61 
    62 !!! AS: idecal is a hack to be able to read planeto starts...
    63 !!!     .... while keeping everything OK for LMDZ EARTH
     53  LOGICAL, PARAMETER :: tnat1 = .TRUE.
     54  !-------------------------------------------------------------------------------
     55  modname = "dynetat0_loc"
     56
     57  !--- Initial state file opening
     58  var = fichnom
     59  CALL err(nf90_open(var, nf90_nowrite, fID), "open", var)
     60  CALL get_var1("controle", tab_cntrl)
     61
     62  !!! AS: idecal is a hack to be able to read planeto starts...
     63  !!!     .... while keeping everything OK for LMDZ EARTH
    6464  IF(planet_type=="generic") THEN
    6565    CALL msg('NOTE NOTE NOTE : Planeto-like start files', modname)
    6666    idecal = 4
    67     annee_ref  = 2000
     67    annee_ref = 2000
    6868  ELSE
    6969    CALL msg('NOTE NOTE NOTE : Earth-like start files', modname)
    7070    idecal = 5
    71     annee_ref  = tab_cntrl(5)
     71    annee_ref = tab_cntrl(5)
    7272  END IF
    73   im         = tab_cntrl(1)
    74   jm         = tab_cntrl(2)
    75   lllm       = tab_cntrl(3)
    76   day_ref    = tab_cntrl(4)
    77   rad        = tab_cntrl(idecal+1)
    78   omeg       = tab_cntrl(idecal+2)
    79   g          = tab_cntrl(idecal+3)
    80   cpp        = tab_cntrl(idecal+4)
    81   kappa      = tab_cntrl(idecal+5)
    82   daysec     = tab_cntrl(idecal+6)
    83   dtvr       = tab_cntrl(idecal+7)
    84   etot0      = tab_cntrl(idecal+8)
    85   ptot0      = tab_cntrl(idecal+9)
    86   ztot0      = tab_cntrl(idecal+10)
    87   stot0      = tab_cntrl(idecal+11)
    88   ang0       = tab_cntrl(idecal+12)
    89   pa         = tab_cntrl(idecal+13)
    90   preff      = tab_cntrl(idecal+14)
    91 
    92   clon       = tab_cntrl(idecal+15)
    93   clat       = tab_cntrl(idecal+16)
    94   grossismx  = tab_cntrl(idecal+17)
    95   grossismy  = tab_cntrl(idecal+18)
    96 
    97   IF ( tab_cntrl(idecal+19)==1. )  THEN
    98     fxyhypb  = .TRUE.
    99 !   dzoomx   = tab_cntrl(25)
    100 !   dzoomy   = tab_cntrl(26)
    101 !   taux     = tab_cntrl(28)
    102 !   tauy     = tab_cntrl(29)
     73  im = tab_cntrl(1)
     74  jm = tab_cntrl(2)
     75  lllm = tab_cntrl(3)
     76  day_ref = tab_cntrl(4)
     77  rad = tab_cntrl(idecal + 1)
     78  omeg = tab_cntrl(idecal + 2)
     79  g = tab_cntrl(idecal + 3)
     80  cpp = tab_cntrl(idecal + 4)
     81  kappa = tab_cntrl(idecal + 5)
     82  daysec = tab_cntrl(idecal + 6)
     83  dtvr = tab_cntrl(idecal + 7)
     84  etot0 = tab_cntrl(idecal + 8)
     85  ptot0 = tab_cntrl(idecal + 9)
     86  ztot0 = tab_cntrl(idecal + 10)
     87  stot0 = tab_cntrl(idecal + 11)
     88  ang0 = tab_cntrl(idecal + 12)
     89  pa = tab_cntrl(idecal + 13)
     90  preff = tab_cntrl(idecal + 14)
     91
     92  clon = tab_cntrl(idecal + 15)
     93  clat = tab_cntrl(idecal + 16)
     94  grossismx = tab_cntrl(idecal + 17)
     95  grossismy = tab_cntrl(idecal + 18)
     96
     97  IF (tab_cntrl(idecal + 19)==1.)  THEN
     98    fxyhypb = .TRUE.
     99    !   dzoomx   = tab_cntrl(25)
     100    !   dzoomy   = tab_cntrl(26)
     101    !   taux     = tab_cntrl(28)
     102    !   tauy     = tab_cntrl(29)
    103103  ELSE
    104104    fxyhypb = .FALSE.
    105     ysinus  = tab_cntrl(idecal+22)==1.
     105    ysinus = tab_cntrl(idecal + 22)==1.
    106106  END IF
    107107
    108   day_ini    = tab_cntrl(30)
    109   itau_dyn   = tab_cntrl(31)
     108  day_ini = tab_cntrl(30)
     109  itau_dyn = tab_cntrl(31)
    110110  start_time = tab_cntrl(32)
    111111
    112 !-------------------------------------------------------------------------------
    113   CALL msg('rad, omeg, g, cpp, kappa = '//TRIM(strStack(real2str([rad,omeg,g,cpp,kappa]))), modname)
    114   CALL check_dim(im,iim,'im','im')
    115   CALL check_dim(jm,jjm,'jm','jm')
    116   CALL check_dim(lllm,llm,'lm','lllm')
    117   CALL get_var1("rlonu",rlonu)
    118   CALL get_var1("rlatu",rlatu)
    119   CALL get_var1("rlonv",rlonv)
    120   CALL get_var1("rlatv",rlatv)
    121   CALL get_var1("cu"  ,cu)
    122   CALL get_var1("cv"  ,cv)
    123   CALL get_var1("aire",aire)
    124 
    125   var="temps"
    126   IF(nf90_inq_varid(fID,var,vID)/=nf90_noerr) THEN
     112  !-------------------------------------------------------------------------------
     113  CALL msg('rad, omeg, g, cpp, kappa = ' // TRIM(strStack(real2str([rad, omeg, g, cpp, kappa]))), modname)
     114  CALL check_dim(im, iim, 'im', 'im')
     115  CALL check_dim(jm, jjm, 'jm', 'jm')
     116  CALL check_dim(lllm, llm, 'lm', 'lllm')
     117  CALL get_var1("rlonu", rlonu)
     118  CALL get_var1("rlatu", rlatu)
     119  CALL get_var1("rlonv", rlonv)
     120  CALL get_var1("rlatv", rlatv)
     121  CALL get_var1("cu", cu)
     122  CALL get_var1("cv", cv)
     123  CALL get_var1("aire", aire)
     124
     125  var = "temps"
     126  IF(nf90_inq_varid(fID, var, vID)/=nf90_noerr) THEN
    127127    CALL msg('missing field <temps> ; trying with <Time>', modname)
    128     var="Time"
    129     CALL err(nf90_inq_varid(fID,var,vID),"inq",var)
     128    var = "Time"
     129    CALL err(nf90_inq_varid(fID, var, vID), "inq", var)
    130130  END IF
    131   CALL err(nf90_get_var(fID,vID,time),"get",var)
     131  CALL err(nf90_get_var(fID, vID, time), "get", var)
    132132
    133133  ALLOCATE(phis_glo(ip1jmp1))
    134   CALL get_var1("phisinit",phis_glo)
    135   phis (ijb_u:ije_u)  =phis_glo(ijb_u:ije_u);    DEALLOCATE(phis_glo)
    136 
    137   ALLOCATE(ucov_glo(ip1jmp1,llm))
    138   CALL get_var2("ucov",ucov_glo)
    139   ucov (ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:);  DEALLOCATE(ucov_glo)
    140 
    141   ALLOCATE(vcov_glo(ip1jm,llm))
    142   CALL get_var2("vcov",vcov_glo)
    143   vcov (ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:);  DEALLOCATE(vcov_glo)
    144 
    145   ALLOCATE(teta_glo(ip1jmp1,llm))
    146   CALL get_var2("teta",teta_glo)
    147   teta (ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:);  DEALLOCATE(teta_glo)
    148 
    149   ALLOCATE(masse_glo(ip1jmp1,llm))
    150   CALL get_var2("masse",masse_glo)
    151   masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:); DEALLOCATE(masse_glo)
    152  
     134  CALL get_var1("phisinit", phis_glo)
     135  phis (ijb_u:ije_u) = phis_glo(ijb_u:ije_u);    DEALLOCATE(phis_glo)
     136
     137  ALLOCATE(ucov_glo(ip1jmp1, llm))
     138  CALL get_var2("ucov", ucov_glo)
     139  ucov (ijb_u:ije_u, :) = ucov_glo(ijb_u:ije_u, :);  DEALLOCATE(ucov_glo)
     140
     141  ALLOCATE(vcov_glo(ip1jm, llm))
     142  CALL get_var2("vcov", vcov_glo)
     143  vcov (ijb_v:ije_v, :) = vcov_glo(ijb_v:ije_v, :);  DEALLOCATE(vcov_glo)
     144
     145  ALLOCATE(teta_glo(ip1jmp1, llm))
     146  CALL get_var2("teta", teta_glo)
     147  teta (ijb_u:ije_u, :) = teta_glo(ijb_u:ije_u, :);  DEALLOCATE(teta_glo)
     148
     149  ALLOCATE(masse_glo(ip1jmp1, llm))
     150  CALL get_var2("masse", masse_glo)
     151  masse(ijb_u:ije_u, :) = masse_glo(ijb_u:ije_u, :); DEALLOCATE(masse_glo)
     152
    153153  ALLOCATE(ps_glo(ip1jmp1))
    154   CALL get_var1("ps",ps_glo)
    155   ps   (ijb_u:ije_u)  =  ps_glo(ijb_u:ije_u);   DEALLOCATE(ps_glo)
    156 
    157 !--- Tracers
    158   ALLOCATE(q_glo(ip1jmp1,llm))
     154  CALL get_var1("ps", ps_glo)
     155  ps   (ijb_u:ije_u) = ps_glo(ijb_u:ije_u);   DEALLOCATE(ps_glo)
     156
     157  !--- Tracers
     158  ALLOCATE(q_glo(ip1jmp1, llm))
    159159  ll = .FALSE.
    160 #ifdef REPROBUS
    161   ll = nf90_inq_varid(fID, 'HNO3tot', vID) /= nf90_noerr                                 !--- DETECT OLD REPRO start.nc FILE
    162 #endif
    163   DO iq=1,nqtot
     160  IF (CPPKEY_REPROBUS) THEN
     161    ll = nf90_inq_varid(fID, 'HNO3tot', vID) /= nf90_noerr                                 !--- DETECT OLD REPRO start.nc FILE
     162  END IF
     163  DO iq = 1, nqtot
    164164    var = tracers(iq)%name
    165165    oldVar = new2oldH2O(var)
    166166    lSkip = ll .AND. var == 'HNO3'                                                       !--- FORCE "HNO3_g" READING FOR "HNO3"
    167 #ifdef REPROBUS
    168     ix = strIdx(newHNO3, var); IF(ix /= 0) oldVar = oldHNO3(ix)                          !--- REPROBUS HNO3 exceptions
    169 #endif
     167    IF (CPPKEY_REPROBUS) THEN
     168      ix = strIdx(newHNO3, var); IF(ix /= 0) oldVar = oldHNO3(ix)                          !--- REPROBUS HNO3 exceptions
     169    END IF
    170170    IF (CPPKEY_INCA) THEN
    171171      IF(var == 'O3') oldVar = 'OX'                                                        !--- DEAL WITH INCA OZONE EXCEPTION
    … …  
    173173    !--------------------------------------------------------------------------------------------------------------------------
    174174    IF(nf90_inq_varid(fID, var, vID) == nf90_noerr .AND. .NOT.lSkip) THEN                !=== REGULAR CASE: AVAILABLE VARIABLE
    175       CALL get_var2(var,q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)
    176     !--------------------------------------------------------------------------------------------------------------------------
     175      CALL get_var2(var, q_glo); q(ijb_u:ije_u, :, iq) = q_glo(ijb_u:ije_u, :)
     176      !--------------------------------------------------------------------------------------------------------------------------
    177177    ELSE IF(nf90_inq_varid(fID, oldVar, vID) == nf90_noerr) THEN                         !=== TRY WITH ALTERNATE NAME
    178       CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to <'//TRIM(oldVar)//'>', modname)
    179       CALL get_var2(oldVar, q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)
    180     !--------------------------------------------------------------------------------------------------------------------------
     178      CALL msg('Tracer <' // TRIM(var) // '> is missing => initialized to <' // TRIM(oldVar) // '>', modname)
     179      CALL get_var2(oldVar, q_glo); q(ijb_u:ije_u, :, iq) = q_glo(ijb_u:ije_u, :)
     180      !--------------------------------------------------------------------------------------------------------------------------
    181181    ELSE IF(tracers(iq)%iso_iGroup == iH2O .AND. niso > 0) THEN                          !=== WATER ISOTOPES
    182       iName    = tracers(iq)%iso_iName
    183       iPhase   = tracers(iq)%iso_iPhase
     182      iName = tracers(iq)%iso_iName
     183      iPhase = tracers(iq)%iso_iPhase
    184184      iqParent = tracers(iq)%iqParent
    185185      IF(tracers(iq)%iso_iZone == 0) THEN
    186          IF (tnat1) THEN
    187                  tnat=1.0
    188                  alpha_ideal=1.0
    189                  WRITE(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1'
    190          else
     186        IF (tnat1) THEN
     187          tnat = 1.0
     188          alpha_ideal = 1.0
     189          WRITE(*, *) 'attention dans dynetat0: les alpha_ideal sont a 1'
     190        else
    191191          IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
    192             CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
    193          endif
    194          CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized with a simplified Rayleigh distillation law.', modname)
    195          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.)
    196          ! Camille 9 mars 2023: point de vigilence: initialisation incohérente
    197          ! avec celle de xt_ancien dans la physiq.
     192                  CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
     193        endif
     194        CALL msg('Tracer <' // TRIM(var) // '> is missing => initialized with a simplified Rayleigh distillation law.', modname)
     195        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.)
     196        ! Camille 9 mars 2023: point de vigilence: initialisation incohérente
     197        ! avec celle de xt_ancien dans la physiq.
    198198      ELSE
    199          CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to its parent isotope concentration.', modname)
    200          ! Camille 9 mars 2023: attention!! seuls les tags qui correspondent à
    201          ! izone=izone_init (définie dans isotrac_mod) sont initialisés comme
    202          ! les parents. Sinon, c'est nul.
    203          ! j'ai fait ça en attendant, mais il faudrait initialiser proprement en
    204          ! remplacant 1 par izone_init dans la ligne qui suit.
    205          IF(tracers(iq)%iso_iZone == 1) THEN
    206            q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase))
    207          ELSE
    208            q(ijb_u:ije_u,:,iq) = 0.
    209          ENDIF
     199        CALL msg('Tracer <' // TRIM(var) // '> is missing => initialized to its parent isotope concentration.', modname)
     200        ! Camille 9 mars 2023: attention!! seuls les tags qui correspondent à
     201        ! izone=izone_init (définie dans isotrac_mod) sont initialisés comme
     202        ! les parents. Sinon, c'est nul.
     203        ! j'ai fait ça en attendant, mais il faudrait initialiser proprement en
     204        ! remplacant 1 par izone_init dans la ligne qui suit.
     205        IF(tracers(iq)%iso_iZone == 1) THEN
     206          q(ijb_u:ije_u, :, iq) = q(ijb_u:ije_u, :, iqIsoPha(iName, iPhase))
     207        ELSE
     208          q(ijb_u:ije_u, :, iq) = 0.
     209        ENDIF
    210210      END IF
    211     !--------------------------------------------------------------------------------------------------------------------------
     211      !--------------------------------------------------------------------------------------------------------------------------
    212212    ELSE                                                                                 !=== MISSING: SET TO 0
    213       CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to zero', modname)
    214       q(ijb_u:ije_u,:,iq)=0.
    215     !--------------------------------------------------------------------------------------------------------------------------
     213      CALL msg('Tracer <' // TRIM(var) // '> is missing => initialized to zero', modname)
     214      q(ijb_u:ije_u, :, iq) = 0.
     215      !--------------------------------------------------------------------------------------------------------------------------
    216216    END IF
    217217  END DO
    218218  DEALLOCATE(q_glo)
    219   CALL err(nf90_close(fID),"close",fichnom)
    220   day_ini=day_ini+INT(time)
    221   time=time-INT(time)
    222 
    223 
    224   CONTAINS
    225 
    226 
    227 SUBROUTINE check_dim(n1,n2,str1,str2)
    228   INTEGER,          INTENT(IN) :: n1, n2
    229   CHARACTER(LEN=*), INTENT(IN) :: str1, str2
    230   CHARACTER(LEN=maxlen) :: s1, s2
    231   IF(n1/=n2) CALL abort_gcm(TRIM(modname), 'value of "'//TRIM(str1)//'" = '//TRIM(int2str(n1))// &
    232    ' read in starting file differs from gcm value of "'//TRIM(str2)//'" = '//TRIM(int2str(n2)), 1)
    233 END SUBROUTINE check_dim
    234 
    235 
    236 SUBROUTINE get_var1(var,v)
    237   CHARACTER(LEN=*), INTENT(IN)  :: var
    238   REAL,             INTENT(OUT) :: v(:)
    239   REAL,             ALLOCATABLE :: w2(:,:), w3(:,:,:)
    240   INTEGER :: nn(3), dids(3), k, nd, ntot
    241 
    242   CALL err(nf90_inq_varid(fID,var,vID),"inq",var)
    243   ierr=nf90_inquire_variable(fID,vID,ndims=nd)
    244   IF(nd==1) THEN
    245     CALL err(nf90_get_var(fID,vID,v),"get",var); RETURN
    246   END IF
    247   ierr=nf90_inquire_variable(fID,vID,dimids=dids)
    248   DO k=1,nd; ierr=nf90_inquire_dimension(fID,dids(k),len=nn(k)); END DO
    249   ntot=PRODUCT(nn(1:nd))
    250   SELECT CASE(nd)
    251     CASE(2); ALLOCATE(w2(nn(1),nn(2)))
    252       CALL err(nf90_get_var(fID,vID,w2),"get",var)
    253       v=RESHAPE(w2,[ntot]); DEALLOCATE(w2)
    254     CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3)))
    255       CALL err(nf90_get_var(fID,vID,w3),"get",var)
    256       v=RESHAPE(w3,[ntot]); DEALLOCATE(w3)
    257   END SELECT
    258 END SUBROUTINE get_var1
    259 
    260 SUBROUTINE get_var2(var,v)
    261   CHARACTER(LEN=*), INTENT(IN)  :: var
    262   REAL,             INTENT(OUT) :: v(:,:)
    263   REAL,             ALLOCATABLE :: w4(:,:,:,:), w3(:,:,:)
    264   INTEGER :: nn(4), dids(4), k, nd
    265 
    266 
    267   CALL err(nf90_inq_varid(fID,var,vID),"inq",var)
    268   ierr=nf90_inquire_variable(fID,vID,ndims=nd)
    269 
    270   IF(nd==1) THEN
    271     CALL err(nf90_get_var(fID,vID,v),"get",var); RETURN
    272   END IF
    273   ierr=nf90_inquire_variable(fID,vID,dimids=dids)
    274 
    275   DO k=1,nd; ierr=nf90_inquire_dimension(fID,dids(k),len=nn(k)); END DO
    276 
    277   SELECT CASE(nd)
    278   CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3)))
    279      CALL err(nf90_get_var(fID,vID,w3),"get",var)
    280      v=RESHAPE(w3,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w3)
    281   CASE(4);  ALLOCATE(w4(nn(1),nn(2),nn(3),nn(4)))
    282      CALL err(nf90_get_var(fID,vID,w4),"get",var)
    283      v=RESHAPE(w4,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w4)
    284   END SELECT
    285 END SUBROUTINE get_var2
    286 
    287 
    288 SUBROUTINE err(ierr,typ,nam)
    289   INTEGER,          INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
    290   CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
    291   CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
    292   IF(ierr==nf90_noerr) RETURN
    293   SELECT CASE(typ)
    294     CASE('inq');   mesg="Field <"//TRIM(nam)//"> is missing"
    295     CASE('get');   mesg="Reading failed for <"//TRIM(nam)//">"
    296     CASE('open');  mesg="File opening failed for <"//TRIM(nam)//">"
    297     CASE('close'); mesg="File closing failed for <"//TRIM(nam)//">"
    298   END SELECT
    299   CALL ABORT_gcm(TRIM(modname),TRIM(mesg),ierr)
    300 END SUBROUTINE err
     219  CALL err(nf90_close(fID), "close", fichnom)
     220  day_ini = day_ini + INT(time)
     221  time = time - INT(time)
     222
     223
     224CONTAINS
     225
     226
     227  SUBROUTINE check_dim(n1, n2, str1, str2)
     228    INTEGER, INTENT(IN) :: n1, n2
     229    CHARACTER(LEN = *), INTENT(IN) :: str1, str2
     230    CHARACTER(LEN = maxlen) :: s1, s2
     231    IF(n1/=n2) CALL abort_gcm(TRIM(modname), 'value of "' // TRIM(str1) // '" = ' // TRIM(int2str(n1)) // &
     232            ' read in starting file differs from gcm value of "' // TRIM(str2) // '" = ' // TRIM(int2str(n2)), 1)
     233  END SUBROUTINE check_dim
     234
     235
     236  SUBROUTINE get_var1(var, v)
     237    CHARACTER(LEN = *), INTENT(IN) :: var
     238    REAL, INTENT(OUT) :: v(:)
     239    REAL, ALLOCATABLE :: w2(:, :), w3(:, :, :)
     240    INTEGER :: nn(3), dids(3), k, nd, ntot
     241
     242    CALL err(nf90_inq_varid(fID, var, vID), "inq", var)
     243    ierr = nf90_inquire_variable(fID, vID, ndims = nd)
     244    IF(nd==1) THEN
     245      CALL err(nf90_get_var(fID, vID, v), "get", var); RETURN
     246    END IF
     247    ierr = nf90_inquire_variable(fID, vID, dimids = dids)
     248    DO k = 1, nd; ierr = nf90_inquire_dimension(fID, dids(k), len = nn(k));
     249    END DO
     250    ntot = PRODUCT(nn(1:nd))
     251    SELECT CASE(nd)
     252    CASE(2); ALLOCATE(w2(nn(1), nn(2)))
     253    CALL err(nf90_get_var(fID, vID, w2), "get", var)
     254    v = RESHAPE(w2, [ntot]); DEALLOCATE(w2)
     255    CASE(3); ALLOCATE(w3(nn(1), nn(2), nn(3)))
     256    CALL err(nf90_get_var(fID, vID, w3), "get", var)
     257    v = RESHAPE(w3, [ntot]); DEALLOCATE(w3)
     258    END SELECT
     259  END SUBROUTINE get_var1
     260
     261  SUBROUTINE get_var2(var, v)
     262    CHARACTER(LEN = *), INTENT(IN) :: var
     263    REAL, INTENT(OUT) :: v(:, :)
     264    REAL, ALLOCATABLE :: w4(:, :, :, :), w3(:, :, :)
     265    INTEGER :: nn(4), dids(4), k, nd
     266
     267    CALL err(nf90_inq_varid(fID, var, vID), "inq", var)
     268    ierr = nf90_inquire_variable(fID, vID, ndims = nd)
     269
     270    IF(nd==1) THEN
     271      CALL err(nf90_get_var(fID, vID, v), "get", var); RETURN
     272    END IF
     273    ierr = nf90_inquire_variable(fID, vID, dimids = dids)
     274
     275    DO k = 1, nd; ierr = nf90_inquire_dimension(fID, dids(k), len = nn(k));
     276    END DO
     277
     278    SELECT CASE(nd)
     279    CASE(3); ALLOCATE(w3(nn(1), nn(2), nn(3)))
     280    CALL err(nf90_get_var(fID, vID, w3), "get", var)
     281    v = RESHAPE(w3, [nn(1) * nn(2), nn(3)]); DEALLOCATE(w3)
     282    CASE(4);  ALLOCATE(w4(nn(1), nn(2), nn(3), nn(4)))
     283    CALL err(nf90_get_var(fID, vID, w4), "get", var)
     284    v = RESHAPE(w4, [nn(1) * nn(2), nn(3)]); DEALLOCATE(w4)
     285    END SELECT
     286  END SUBROUTINE get_var2
     287
     288
     289  SUBROUTINE err(ierr, typ, nam)
     290    INTEGER, INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
     291    CHARACTER(LEN = *), INTENT(IN) :: typ    !--- TYPE OF OPERATION
     292    CHARACTER(LEN = *), INTENT(IN) :: nam    !--- FIELD/FILE NAME
     293    IF(ierr==nf90_noerr) RETURN
     294    SELECT CASE(typ)
     295    CASE('inq');   mesg = "Field <" // TRIM(nam) // "> is missing"
     296    CASE('get');   mesg = "Reading failed for <" // TRIM(nam) // ">"
     297    CASE('open');  mesg = "File opening failed for <" // TRIM(nam) // ">"
     298    CASE('close'); mesg = "File closing failed for <" // TRIM(nam) // ">"
     299    END SELECT
     300    CALL ABORT_gcm(TRIM(modname), TRIM(mesg), ierr)
     301  END SUBROUTINE err
    301302
    302303END SUBROUTINE dynetat0_loc

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

    r5184 r5185  
    3939          xios_set_current_context, &
    4040          using_xios
    41   USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
     41  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO, CPPKEY_REPROBUS
    4242  USE lmdz_description, ONLY: descript
    4343  USE lmdz_iniprint, ONLY: lunout, prt_level
    … …  
    8181  !   Declarations:
    8282  !   -------------
    83 
    84 
    85 
    8683
    8784  REAL, INTENT(IN) :: time_0 ! not used
    … …  
    319316
    320317  IF (ok_guide) THEN
    321     CALL guide_main(itau,ucov,vcov,teta,q,masse,ps)
    322 !$OMP BARRIER
     318    CALL guide_main(itau, ucov, vcov, teta, q, masse, ps)
     319    !$OMP BARRIER
    323320  ENDIF
    324321
    … …  
    796793  !c$OMP END PARALLEL
    797794
    798 
    799 
    800795  IF(apphys)  THEN
    801796
    … …  
    952947    endif
    953948
    954       IF (ANY(type_trac == ['inca', 'inco'])) THEN
    955         CALL finalize_inca
    956         ! switching back to LMDZDYN context
    957         !$OMP MASTER
    958         IF (ok_dyn_xios) THEN
    959           CALL xios_set_current_context(dyn3d_ctx_handle)
    960         ENDIF
    961         !$OMP END MASTER
     949    IF (ANY(type_trac == ['inca', 'inco'])) THEN
     950      CALL finalize_inca
     951      ! switching back to LMDZDYN context
     952      !$OMP MASTER
     953      IF (ok_dyn_xios) THEN
     954        CALL xios_set_current_context(dyn3d_ctx_handle)
    962955      ENDIF
    963 #ifdef REPROBUS
    964      IF (type_trac == 'repr') CALL finalize_reprobus
    965 #endif
     956      !$OMP END MASTER
     957    ENDIF
     958    IF (CPPKEY_REPROBUS) THEN
     959      IF (type_trac == 'repr') CALL finalize_reprobus
     960    END IF
    966961
    967962    !$OMP MASTER
    … …  
    10051000      !$OMP END MASTER
    10061001
    1007         IF (ANY(type_trac == ['inca', 'inco'])) THEN
    1008           CALL finalize_inca
    1009           ! switching back to LMDZDYN context
    1010           !$OMP MASTER
    1011           IF (ok_dyn_xios) THEN
    1012             CALL xios_set_current_context(dyn3d_ctx_handle)
    1013           ENDIF
    1014           !$OMP END MASTER
     1002      IF (ANY(type_trac == ['inca', 'inco'])) THEN
     1003        CALL finalize_inca
     1004        ! switching back to LMDZDYN context
     1005        !$OMP MASTER
     1006        IF (ok_dyn_xios) THEN
     1007          CALL xios_set_current_context(dyn3d_ctx_handle)
    10151008        ENDIF
    1016 #ifdef REPROBUS
    1017           IF (type_trac == 'repr') CALL finalize_reprobus
    1018 #endif
     1009        !$OMP END MASTER
     1010      ENDIF
     1011      IF (CPPKEY_REPROBUS) THEN
     1012        IF (type_trac == 'repr') CALL finalize_reprobus
     1013      END IF
    10191014
    10201015      !$OMP MASTER
    … …  
    10441039      !$OMP BARRIER
    10451040
    1046          IF (ok_dynzon) THEN
    1047 
    1048           CALL bilan_dyn_loc(2,dtvr*iperiod,dtvr*day_step*periodav, &
    1049                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
    1050 
    1051           ENDIF !ok_dynzon
    1052 
    1053           IF (ok_dyn_ave) THEN
    1054              CALL writedynav_loc(itau,vcov, &
    1055                    ucov,teta,pk,phi,q,masse,ps,phis)
    1056           ENDIF
     1041      IF (ok_dynzon) THEN
     1042
     1043        CALL bilan_dyn_loc(2, dtvr * iperiod, dtvr * day_step * periodav, &
     1044                ps, masse, pk, pbaru, pbarv, teta, phi, ucov, vcov, q)
     1045
     1046      ENDIF !ok_dynzon
     1047
     1048      IF (ok_dyn_ave) THEN
     1049        CALL writedynav_loc(itau, vcov, &
     1050                ucov, teta, pk, phi, q, masse, ps, phis)
     1051      ENDIF
    10571052
    10581053    ENDIF
    … …  
    10731068        !$OMP BARRIER
    10741069
    1075          IF (ok_dyn_ins) THEN
    1076              CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, &
    1077                    masse,ps,phis)
    1078          endif
     1070        IF (ok_dyn_ins) THEN
     1071          CALL writehist_loc(itau, vcov, ucov, teta, pk, phi, q, &
     1072                  masse, ps, phis)
     1073        endif
    10791074
    10801075        IF (ok_dyn_xios) THEN
    … …  
    11671162        !$OMP END MASTER
    11681163
    1169           IF (ANY(type_trac == ['inca', 'inco'])) THEN
    1170             CALL finalize_inca
    1171             ! switching back to LMDZDYN context
    1172             !$OMP MASTER
    1173             IF (ok_dyn_xios) THEN
    1174               CALL xios_set_current_context(dyn3d_ctx_handle)
    1175             ENDIF
    1176             !$OMP END MASTER
     1164        IF (ANY(type_trac == ['inca', 'inco'])) THEN
     1165          CALL finalize_inca
     1166          ! switching back to LMDZDYN context
     1167          !$OMP MASTER
     1168          IF (ok_dyn_xios) THEN
     1169            CALL xios_set_current_context(dyn3d_ctx_handle)
    11771170          ENDIF
    1178 #ifdef REPROBUS
    1179              IF (type_trac == 'repr') CALL finalize_reprobus
    1180 #endif
     1171          !$OMP END MASTER
     1172        ENDIF
     1173        IF (CPPKEY_REPROBUS) THEN
     1174          IF (type_trac == 'repr') CALL finalize_reprobus
     1175        END IF
    11811176
    11821177        !$OMP MASTER
    … …  
    12001195        ENDIF
    12011196
    1202           ! Ehouarn: re-compute geopotential for outputs
    1203 !$OMP BARRIER
    1204 !$OMP MASTER
    1205           CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi)
    1206 !$OMP END MASTER
    1207 !$OMP BARRIER
    1208 
    1209            IF (ok_dynzon) THEN
    1210            CALL bilan_dyn_loc(2,dtvr*iperiod,dtvr*day_step*periodav, &
    1211                  ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
    1212            ENDIF
    1213 
    1214            IF (ok_dyn_ave) THEN
    1215              CALL writedynav_loc(itau,vcov, &
    1216                    ucov,teta,pk,phi,q,masse,ps,phis)
    1217            ENDIF
    1218 
    1219       ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin)
    1220 
    1221       IF(MOD(itau, iecri)==0) THEN
    1222 
     1197        ! Ehouarn: re-compute geopotential for outputs
    12231198        !$OMP BARRIER
    12241199        !$OMP MASTER
    … …  
    12271202        !$OMP BARRIER
    12281203
    1229 
    1230           IF (ok_dyn_ins) THEN
    1231              CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, &
    1232                    masse,ps,phis)
    1233           endif ! of if (ok_dyn_ins)
     1204        IF (ok_dynzon) THEN
     1205          CALL bilan_dyn_loc(2, dtvr * iperiod, dtvr * day_step * periodav, &
     1206                  ps, masse, pk, pbaru, pbarv, teta, phi, ucov, vcov, q)
     1207        ENDIF
     1208
     1209        IF (ok_dyn_ave) THEN
     1210          CALL writedynav_loc(itau, vcov, &
     1211                  ucov, teta, pk, phi, q, masse, ps, phis)
     1212        ENDIF
     1213
     1214      ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin)
     1215
     1216      IF(MOD(itau, iecri)==0) THEN
     1217
     1218        !$OMP BARRIER
     1219        !$OMP MASTER
     1220        CALL geopot_loc(ip1jmp1, teta, pk, pks, phis, phi)
     1221        !$OMP END MASTER
     1222        !$OMP BARRIER
     1223
     1224        IF (ok_dyn_ins) THEN
     1225          CALL writehist_loc(itau, vcov, ucov, teta, pk, phi, q, &
     1226                  masse, ps, phis)
     1227        endif ! of if (ok_dyn_ins)
    12341228
    12351229        IF (ok_dyn_xios) THEN
    … …  
    12691263  !$OMP END MASTER
    12701264
    1271     IF (ANY(type_trac == ['inca', 'inco'])) THEN
    1272       CALL finalize_inca
    1273       ! switching back to LMDZDYN context
    1274       !$OMP MASTER
    1275       IF (ok_dyn_xios) THEN
    1276         CALL xios_set_current_context(dyn3d_ctx_handle)
    1277       ENDIF
    1278       !$OMP END MASTER
     1265  IF (ANY(type_trac == ['inca', 'inco'])) THEN
     1266    CALL finalize_inca
     1267    ! switching back to LMDZDYN context
     1268    !$OMP MASTER
     1269    IF (ok_dyn_xios) THEN
     1270      CALL xios_set_current_context(dyn3d_ctx_handle)
    12791271    ENDIF
    1280 #ifdef REPROBUS
    1281   IF (type_trac == 'repr') CALL finalize_reprobus
    1282 #endif
     1272    !$OMP END MASTER
     1273  ENDIF
     1274  IF (CPPKEY_REPROBUS) THEN
     1275    IF (type_trac == 'repr') CALL finalize_reprobus
     1276  END IF
    12831277
    12841278  !$OMP MASTER

  • LMDZ6/branches/Amaury_dev/libf/dynphy_lonlat/phylmd/iniphysiq_mod.F90

    r5182 r5185  
    1717    USE lmdz_infotrac, ONLY: nbtr, type_trac
    1818
    19 #ifdef REPROBUS
    20   USE CHEM_REP, ONLY: Init_chem_rep_phys
     19    USE lmdz_reprobus_wrappers, ONLY: Init_chem_rep_phys
    2120#ifdef CPP_PARA
    2221  USE parallel_lmdz, ONLY: mpi_size, mpi_rank
    2322  USE bands, ONLY: distrib_phys
    2423#endif
    25   USE lmdz_phys_omp_data, ONLY: klon_omp
    26 #endif
     24    USE lmdz_phys_omp_data, ONLY: klon_omp
    2725    USE control_mod, ONLY: dayref, anneeref, day_step, nday, offline, iphysiq
    2826    USE inifis_mod, ONLY: inifis
    … …  
    4442    USE lmdz_comgeom
    4543    USE lmdz_tracstoke
     44    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS
    4645
    47 USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    48   USE lmdz_paramet
     46    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     47    USE lmdz_paramet
    4948    IMPLICIT NONE
    5049
    … …  
    5352    ! geometrical arrays for the physics
    5453    ! =======================================================================
    55 
    56 
    57 
    5854
    5955    REAL, INTENT (IN) :: prad ! radius of the planet (m)
    … …  
    137133    ! Initializations for Reprobus
    138134    IF (type_trac == 'repr') THEN
    139 #ifdef REPROBUS
    140     CALL Init_chem_rep_phys(klon_omp,nlayer)
    141     CALL init_reprobus_para( &
    142           nbp_lon,nbp_lat,nbp_lev,klon_glo,mpi_size, &
    143           distrib_phys,communicator)
    144 #endif
     135      IF (CPPKEY_REPROBUS) THEN
     136        CALL Init_chem_rep_phys(klon_omp, nlayer)
     137        CALL init_reprobus_para(&
     138                nbp_lon, nbp_lat, nbp_lev, klon_glo, mpi_size, &
     139                distrib_phys, communicator)
     140      END IF
    145141    ENDIF
    146142    !$OMP END PARALLEL
    147143
    148144    IF (type_trac == 'repr') THEN
    149 #ifdef REPROBUS
    150     CALL init_reprobus_para( &
    151           nbp_lon,nbp_lat,nbp_lev,klon_glo,mpi_size, &
    152           distrib_phys,communicator)
    153 #endif
     145      IF (CPPKEY_REPROBUS) THEN
     146        CALL init_reprobus_para(&
     147                nbp_lon, nbp_lat, nbp_lev, klon_glo, mpi_size, &
     148                distrib_phys, communicator)
     149      END IF
    154150    ENDIF
    155151

  • LMDZ6/branches/Amaury_dev/libf/misc/lmdz_reprobus_wrappers.F90

    r5182 r5185  
    44
    55#ifdef REPROBUS
    6   USE CHEM_REP, ONLY: init_chem_rep_trac
     6  USE CHEM_REP, ONLY: init_chem_rep_trac, itroprep
    77#else
     8
     9  ! TODO ugly temp solution until we properly wrap the REPROBUS code
     10  USE lmdz_dimensions, ONLY: iim, jjm
     11  INTEGER :: itroprep(iim), iter, ndimozon
     12  REAL :: rsuntime(2), pdt_rep, daynum, solaireTIME, ptrop(iim), ttrop(iim), ztrop(iim), gravit, Z1, &
     13          Z2, fac, B
     14  REAL, DIMENSION(iim, jjm) :: pdel, d_q_rep, d_ql_rep, d_qi_rep, rch42d, rn2o2d, rcfc112d, rcfc122d
     15  LOGICAL :: ok_suntime, ok_rtime2d
    816
    917CONTAINS
    … …  
    1321  END SUBROUTINE lmdz_reprobus_wrapper_abort
    1422
     23  ! TODO replace ugly wrappers below with actual signatures from REPROBUS code
     24
     25  SUBROUTINE init_chem_rep_trac(nbtr, nqo, name)
     26    INTEGER :: nbtr, nqo
     27    CHARACTER(len = 256) :: name(:)
     28    CALL lmdz_reprobus_wrapper_abort
     29  END SUBROUTINE init_chem_rep_trac
     30
     31  SUBROUTINE init_chem_rep_phys(klon, klev)
     32    INTEGER :: klon, klev
     33    CALL lmdz_reprobus_wrapper_abort
     34  END SUBROUTINE init_chem_rep_phys
     35
     36  SUBROUTINE init_chem_rep_xjour(j)
     37    REAL :: j
     38    CALL lmdz_reprobus_wrapper_abort
     39  END SUBROUTINE init_chem_rep_xjour
     40
    1541#endif
    1642END MODULE lmdz_reprobus_wrappers

  • LMDZ6/branches/Amaury_dev/libf/phy_common/lmdz_physics_distribution.F90

    r5117 r5185  
    1313    USE dimphy, ONLY: Init_dimphy
    1414    USE infotrac_phy, ONLY: type_trac
    15 #ifdef REPROBUS
    16   USE CHEM_REP, ONLY: Init_chem_rep_phys
    17 #endif
    18     USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA
     15    USE lmdz_reprobus_wrappers, ONLY: Init_chem_rep_phys
     16    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS
    1917    IMPLICIT NONE
    2018    INTEGER, INTENT(IN) :: grid_type
    … …  
    3533    END IF
    3634
    37 #ifdef REPROBUS
    38 ! Initialization of Reprobus
    39     IF (type_trac == 'repr') CALL Init_chem_rep_phys(klon_omp,nbp_lev)
    40 #endif
     35    IF (CPPKEY_REPROBUS) THEN
     36      ! Initialization of Reprobus
     37      IF (type_trac == 'repr') CALL Init_chem_rep_phys(klon_omp, nbp_lev)
     38    END IF
    4139
    4240    !$OMP END PARALLEL
    … …  
    4947  !  USE dimphy, ONLY: Init_dimphy
    5048  !  USE infotrac_phy, ONLY: type_trac
    51   !#ifdef REPROBUS
    52   !  USE CHEM_REP, ONLY: Init_chem_rep_phys
    53   !#endif
     49  !IF (CPPKEY_REPROBUS) THEN
     50  !  USE lmdz_reprobus_wrappers, ONLY: Init_chem_rep_phys
     51  !END IF
    5452
    5553  !  IMPLICIT NONE
    … …  
    6765  !    CALL Init_dimphy(klon_omp,nbp_lev)
    6866
    69   !#ifdef REPROBUS
     67  !IF (CPPKEY_REPROBUS) THEN
    7068  !! Initialization of Reprobus
    7169  !    IF (type_trac == 'repr') CALL Init_chem_rep_phys(klon_omp,nbp_lev)
    7270  !    END IF
    73   !#endif
     71  !END IF
    7472
    7573  !!$OMP END PARALLEL

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/MISR_simulator.F

    r5099 r5185  
    181181        ! NOW for MISR ..
    182182        ! if there a cloud ... start the counter ... store this height
    183         if(thres_crossed_MISR .eq. 0 .and. dtau .gt. 0.) then
     183        if(thres_crossed_MISR .eq. 0 .AND. dtau .gt. 0.) then
    184184       
    185185            ! first encountered a "cloud"
    … …  
    188188        endif   
    189189               
    190         if( thres_crossed_MISR .lt. 99 .and.
     190        if( thres_crossed_MISR .lt. 99 .AND.
    191191     &              thres_crossed_MISR .gt. 0 ) then
    192192     
    … …  
    207207            ! then MISR will like see a top below the top of the current
    208208            ! layer
    209             if( dtau.gt.0 .and. (cloud_dtau-dtau) .lt. 1) then
     209            if( dtau.gt.0 .AND. (cloud_dtau-dtau) .lt. 1) then
    210210           
    211211                if(dtau .lt. 1 .or. ilev.eq.1 .or. ilev.eq.nlev) then
    … …  
    228228       
    229229            ! check for a distinctive water layer
    230             if(dtau .gt. 1 .and. at(j,ilev).gt.273 ) then
     230            if(dtau .gt. 1 .AND. at(j,ilev).gt.273 ) then
    231231     
    232232                    ! must be a water cloud ...
    … …  
    292292           do j=2,npoints-1
    293293           
    294             if(box_MISR_ztop(j-1,1).gt.0 .and.
     294            if(box_MISR_ztop(j-1,1).gt.0 .AND.
    295295     &             box_MISR_ztop(j+1,1).gt.0       ) then
    296296
    297297                if( abs( box_MISR_ztop(j-1,1) - 
    298298     &                   box_MISR_ztop(j+1,1) ) .lt. 500
    299      &              .and.
     299     &              .AND.
    300300     &                   box_MISR_ztop(j,1) .lt.
    301301     &                   box_MISR_ztop(j+1,1)     ) then
    … …  
    312312         do ibox=2,ncol-1
    313313           
    314             if(box_MISR_ztop(1,ibox-1).gt.0 .and.
     314            if(box_MISR_ztop(1,ibox-1).gt.0 .AND.
    315315     &             box_MISR_ztop(1,ibox+1).gt.0        ) then
    316316
    317317                if( abs( box_MISR_ztop(1,ibox-1) - 
    318318     &                   box_MISR_ztop(1,ibox+1) ) .lt. 500
    319      &              .and.
     319     &              .AND.
    320320     &                   box_MISR_ztop(1,ibox) .lt.
    321321     &                   box_MISR_ztop(1,ibox+1)     ) then
    … …  
    361361                  itau=1
    362362              else if (tau(j,ibox) .ge. isccp_taumin                                   
    363      &          .and. tau(j,ibox) .lt. 1.3) then
     363     &          .AND. tau(j,ibox) .lt. 1.3) then
    364364                  itau=2
    365365              else if (tau(j,ibox) .ge. 1.3
    366      &          .and. tau(j,ibox) .lt. 3.6) then
     366     &          .AND. tau(j,ibox) .lt. 3.6) then
    367367                  itau=3
    368368              else if (tau(j,ibox) .ge. 3.6
    369      &          .and. tau(j,ibox) .lt. 9.4) then
     369     &          .AND. tau(j,ibox) .lt. 9.4) then
    370370                  itau=4
    371371              else if (tau(j,ibox) .ge. 9.4
    372      &          .and. tau(j,ibox) .lt. 23.) then
     372     &          .AND. tau(j,ibox) .lt. 23.) then
    373373                  itau=5
    374374              else if (tau(j,ibox) .ge. 23.
    375      &          .and. tau(j,ibox) .lt. 60.) then
     375     &          .AND. tau(j,ibox) .lt. 60.) then
    376376                  itau=6
    377377              else if (tau(j,ibox) .ge. 60.) then

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/calc_Re.F90

    r5160 r5185  
    6363
    6464  ! // if density is constant, set equivalent values for apm and bpm
    65   if ((rho_c > 0) .and. (apm < 0)) then
     65  if ((rho_c > 0) .AND. (apm < 0)) then
    6666    apm = (pi/6)*rho_c
    6767    bpm = 3.
    … …  
    7070  ! Exponential is same as modified gamma with vu =1
    7171  ! if Np is specified then we will just treat as modified gamma
    72   if(dtype.eq.2 .and. Np>0) then
     72  if(dtype.eq.2 .AND. Np>0) then
    7373    local_dtype=1;
    7474    local_p3=1;
    … …  
    117117   
    118118
    119     if( Np.eq.0 .and. p2+1 > 1E-8) then     ! use default value for MEAN diameter as first default
     119    if( Np.eq.0 .AND. p2+1 > 1E-8) then     ! use default value for MEAN diameter as first default
    120120     
    121121        dm = p2             ! by definition, should have units of microns
    … …  
    231231     
    232232    ! get rg ...
    233     if( Np.eq.0 .and. (abs(p2+1) > 1E-8) ) then ! use default value of rg
     233    if( Np.eq.0 .AND. (abs(p2+1) > 1E-8) ) then ! use default value of rg
    234234   
    235235            rg = p2

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_output_write_mod.F90

    r5158 r5185  
    185185    DO k=1,PARASOL_NREFL
    186186     DO ip=1, Npoints
    187       if (stlidar%cldlayer(ip,4).gt.0.01.and.stlidar%parasolrefl(ip,k).ne.missing_val) then
     187      if (stlidar%cldlayer(ip,4).gt.0.01.AND.stlidar%parasolrefl(ip,k).ne.missing_val) then
    188188        parasolcrefl(ip,k)=(stlidar%parasolrefl(ip,k)-0.03*(1.-stlidar%cldlayer(ip,4)))/ &
    189189                             stlidar%cldlayer(ip,4)
    … …  
    240240
    241241!!! Sorties combinees Cloudsat et Calipso
    242  if (cfg%Llidar_sim .and. cfg%Lradar_sim) then
     242 if (cfg%Llidar_sim .AND. cfg%Lradar_sim) then
    243243   where(stradar%lidar_only_freq_cloud == R_UNDEF) &
    244244                           stradar%lidar_only_freq_cloud = missing_val

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/cosp_read_otputkeys.F90

    r5160 r5185  
    439439    Ltbrttov = .false.
    440440  endif
    441   if ((.not.Lradar_sim).and.(.not.Llidar_sim).and. &
    442       (.not.Lisccp_sim).and.(.not.Lmisr_sim)) then
     441  if ((.not.Lradar_sim).AND.(.not.Llidar_sim).AND. &
     442      (.not.Lisccp_sim).AND.(.not.Lmisr_sim)) then
    443443    Lfracout = .false.
    444444    Lstats = .false.
    … …  
    469469
    470470  ! Diagnostics that use Radar and Lidar
    471   if (((Lclcalipso2).or.(Lcltlidarradar)).and.((Lradar_sim).or.(Llidar_sim))) then
     471  if (((Lclcalipso2).or.(Lcltlidarradar)).AND.((Lradar_sim).or.(Llidar_sim))) then
    472472    Lclcalipso2    = .true.
    473473    Lcltlidarradar = .true.

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/dsd.F90

    r5160 r5185  
    9191 
    9292  ! // if density is constant, store equivalent values for apm and bpm
    93   if ((rho_c > 0) .and. (apm < 0)) then
     93  if ((rho_c > 0) .AND. (apm < 0)) then
    9494    apm = (pi/6)*rho_c
    9595    bpm = 3.
    … …  
    9999  ! if only Np given then calculate Re
    100100  ! if neigher than use other defaults (p1,p2,p3) following quickbeam documentation
    101   if(Re==0 .and. Np>0) then
     101  if(Re==0 .AND. Np>0) then
    102102   
    103103        call calc_Re(Q,Np,rho_a, &
    … …  
    270270      if (tc < -30) then
    271271        bhp = -1.75+0.09*((tc+273)-243.16)
    272       elseif ((tc >= -30) .and. (tc < -9)) then
     272      elseif ((tc >= -30) .AND. (tc < -9)) then
    273273        bhp = -3.25-0.06*((tc+273)-265.66)
    274274      else
    … …  
    280280      if (tc < -35) then
    281281        bhp = -1.75+0.09*((tc+273)-243.16)
    282       elseif ((tc >= -35) .and. (tc < -17.5)) then
     282      elseif ((tc >= -35) .AND. (tc < -17.5)) then
    283283        bhp = -2.65+0.09*((tc+273)-255.66)
    284       elseif ((tc >= -17.5) .and. (tc < -9)) then
     284      elseif ((tc >= -17.5) .AND. (tc < -9)) then
    285285        bhp = -3.25-0.06*((tc+273)-265.66)
    286286      else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/format_input.F90

    r5158 r5185  
    114114! :: space-based: heights must be descending
    115115  if ( &
    116      (sfc_radar == 1 .and. hgt_descending) .or.  &
    117      (sfc_radar == 0 .and. (.not. hgt_descending)) &
     116     (sfc_radar == 1 .AND. hgt_descending) .or.  &
     117     (sfc_radar == 0 .AND. (.not. hgt_descending)) &
    118118     ) &
    119119  then

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/icarus.F

    r5099 r5185  
    364364      do 12 ilev=1,nlev
    365365        do j=1,npoints
    366          if (pfull(j,ilev) .lt. 40000. .and.
    367      &          pfull(j,ilev) .gt.  5000. .and.
     366         if (pfull(j,ilev) .lt. 40000. .AND.
     367     &          pfull(j,ilev) .gt.  5000. .AND.
    368368     &          at(j,ilev) .lt. attropmin(j)) then
    369369                ptrop(j) = pfull(j,ilev)
    … …  
    377377      do 13 ilev=1,nlev
    378378        do j=1,npoints
    379            if (at(j,ilev) .gt. atmax(j) .and.
     379           if (at(j,ilev) .gt. atmax(j) .AND.
    380380     &              ilev  .ge. itrop(j)) atmax(j)=at(j,ilev)
    381381        enddo
    … …  
    811811          if (top_height .eq. 1) then
    812812            do j=1,npoints 
    813               if (transmax(j) .gt. 0.001 .and.
     813              if (transmax(j) .gt. 0.001 .AND.
    814814     &          transmax(j) .le. 0.9999999) then
    815815                fluxtopinit(j) = fluxtop(j,ibox)
    … …  
    820820              do j=1,npoints 
    821821                if (tau(j,ibox) .gt. (tauchk            )) then
    822                 if (transmax(j) .gt. 0.001 .and.
     822                if (transmax(j) .gt. 0.001 .AND.
    823823     &            transmax(j) .le. 0.9999999) then
    824824                  emcld(j,ibox) = 1. - exp(-1. * tauir(j)  )
    … …  
    845845                !at this point in the code
    846846                tb(j,ibox)= 1307.27/ (log(1. + (1./fluxtop(j,ibox))))
    847                 if (top_height.eq.1.and.tauir(j).lt.taumin(j)) then
     847                if (top_height.eq.1.AND.tauir(j).lt.taumin(j)) then
    848848                         tb(j,ibox) = attrop(j) - 5.
    849849                   tau(j,ibox) = 2.13*taumin(j)
    … …  
    930930            do j=1,npoints
    931931             if (ilev .ge. itrop(j)) then
    932               if ((at(j,ilev)   .ge. tb(j,ibox) .and.
     932              if ((at(j,ilev)   .ge. tb(j,ibox) .AND.
    933933     &          at(j,ilev+1) .le. tb(j,ibox)) .or.
    934      &          (at(j,ilev) .le. tb(j,ibox) .and.
     934     &          (at(j,ilev) .le. tb(j,ibox) .AND.
    935935     &          at(j,ilev+1) .ge. tb(j,ibox))) then
    936936                nmatch(j)=nmatch(j)+1
    … …  
    976976            do j=1,npoints     
    977977              if ((ptop(j,ibox) .eq. 0. )
    978      &           .and.(frac_out(j,ibox,ilev) .ne. 0)) then
     978     &           .AND.(frac_out(j,ibox,ilev) .ne. 0)) then
    979979                ptop(j,ibox)=phalf(j,ilev)
    980980              levmatch(j,ibox)=ilev
    … …  
    10481048
    10491049          if (tau(j,ibox) .gt. (tauchk            )
    1050      &      .and. ptop(j,ibox) .gt. 0.) then
     1050     &      .AND. ptop(j,ibox) .gt. 0.) then
    10511051              box_cloudy(j,ibox)=.true.
    10521052          endif
    … …  
    10981098              else if (tau(j,ibox) .ge. isccp_taumin
    10991099     &                                   
    1100      &          .and. tau(j,ibox) .lt. 1.3) then
     1100     &          .AND. tau(j,ibox) .lt. 1.3) then
    11011101                itau(j)=2
    11021102              else if (tau(j,ibox) .ge. 1.3
    1103      &          .and. tau(j,ibox) .lt. 3.6) then
     1103     &          .AND. tau(j,ibox) .lt. 3.6) then
    11041104                itau(j)=3
    11051105              else if (tau(j,ibox) .ge. 3.6
    1106      &          .and. tau(j,ibox) .lt. 9.4) then
     1106     &          .AND. tau(j,ibox) .lt. 9.4) then
    11071107                  itau(j)=4
    11081108              else if (tau(j,ibox) .ge. 9.4
    1109      &          .and. tau(j,ibox) .lt. 23.) then
     1109     &          .AND. tau(j,ibox) .lt. 23.) then
    11101110                  itau(j)=5
    11111111              else if (tau(j,ibox) .ge. 23.
    1112      &          .and. tau(j,ibox) .lt. 60.) then
     1112     &          .AND. tau(j,ibox) .lt. 60.) then
    11131113                  itau(j)=6
    11141114              else if (tau(j,ibox) .ge. 60.) then
    … …  
    11181118              !determine cloud top pressure category
    11191119              if (    ptop(j,ibox) .gt. 0. 
    1120      &          .and.ptop(j,ibox) .lt. 180.) then
     1120     &          .AND.ptop(j,ibox) .lt. 180.) then
    11211121                  ipres(j)=1
    11221122              else if(ptop(j,ibox) .ge. 180.
    1123      &          .and.ptop(j,ibox) .lt. 310.) then
     1123     &          .AND.ptop(j,ibox) .lt. 310.) then
    11241124                  ipres(j)=2
    11251125              else if(ptop(j,ibox) .ge. 310.
    1126      &          .and.ptop(j,ibox) .lt. 440.) then
     1126     &          .AND.ptop(j,ibox) .lt. 440.) then
    11271127                  ipres(j)=3
    11281128              else if(ptop(j,ibox) .ge. 440.
    1129      &          .and.ptop(j,ibox) .lt. 560.) then
     1129     &          .AND.ptop(j,ibox) .lt. 560.) then
    11301130                  ipres(j)=4
    11311131              else if(ptop(j,ibox) .ge. 560.
    1132      &          .and.ptop(j,ibox) .lt. 680.) then
     1132     &          .AND.ptop(j,ibox) .lt. 680.) then
    11331133                  ipres(j)=5
    11341134              else if(ptop(j,ibox) .ge. 680.
    1135      &          .and.ptop(j,ibox) .lt. 800.) then
     1135     &          .AND.ptop(j,ibox) .lt. 800.) then
    11361136                  ipres(j)=6
    11371137              else if(ptop(j,ibox) .ge. 800.) then
    … …  
    11401140
    11411141              !update frequencies
    1142               if(ipres(j) .gt. 0.and.itau(j) .gt. 0) then
     1142              if(ipres(j) .gt. 0.AND.itau(j) .gt. 0) then
    11431143              fq_isccp(j,itau(j),ipres(j))=
    11441144     &          fq_isccp(j,itau(j),ipres(j))+ boxarea

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp.F90

    r5160 r5185  
    139139      !     and reff_zero    == .false.  Reff use in lidar and set to 0 for radar
    140140  endif
    141   if ((.not. gbx%use_reff) .and. (reff_zero)) then ! No Reff in radar. Default in lidar
     141  if ((.not. gbx%use_reff) .AND. (reff_zero)) then ! No Reff in radar. Default in lidar
    142142        gbx%Reff = DEFAULT_LIDAR_REFF
    143143        PRINT *, '---------- COSP WARNING ------------'

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_isccp_simulator.F90

    r5158 r5185  
    8888 
    8989  ! Check if there is any value slightly greater than 1
    90   where ((y%totalcldarea > 1.0-1.e-5) .and. (y%totalcldarea < 1.0+1.e-5))
     90  where ((y%totalcldarea > 1.0-1.e-5) .AND. (y%totalcldarea < 1.0+1.e-5))
    9191    y%totalcldarea = 1.0
    9292  endwhere

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_radar.F90

    r5158 r5185  
    144144
    145145      if ( &
    146          (gbx%surface_radar == 1 .and. hgt_descending) .or.  &
    147          (gbx%surface_radar == 0 .and. (.not. hgt_descending)) &
     146         (gbx%surface_radar == 1 .AND. hgt_descending) .or.  &
     147         (gbx%surface_radar == 0 .AND. (.not. hgt_descending)) &
    148148         ) &
    149149      then

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_simulator.F90

    r5160 r5185  
    8686!   do j=1,gbx%Nlevels
    8787!   do i=1,gbx%Npoints
    88 !     if ((gbx%mr_hydro(i,j,k)>0.0).and.(gbx%Reff(i,j,k)<=0.0)) inconsistent=.true.
     88!     if ((gbx%mr_hydro(i,j,k)>0.0).AND.(gbx%Reff(i,j,k)<=0.0)) inconsistent=.true.
    8989!   enddo
    9090!   enddo

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_stats.F90

    r5158 r5185  
    140140
    141141        !++++++++++++ Lidar-only cloud amount and lidar&radar total cloud mount ++++++++++++++++
    142         if (cfg%Lradar_sim.and.cfg%Llidar_sim) call cosp_lidar_only_cloud(Npoints,Ncolumns,Nlr, &
     142        if (cfg%Lradar_sim.AND.cfg%Llidar_sim) call cosp_lidar_only_cloud(Npoints,Ncolumns,Nlr, &
    143143                                    temp_c,betatot_out,betaperptot_out,betamol_c,Ze_out, &
    144144                                    stradar%lidar_only_freq_cloud,stradar%radar_lidar_tcc)
    … …  
    162162                        ,stlidar%parasolrefl,vgrid%z,stlidar%profSR)                    !OPAQ !TIBO
    163163        !++++++++++++ Lidar-only cloud amount and lidar&radar total cloud mount ++++++++++++++++
    164         if (cfg%Lradar_sim.and.cfg%Llidar_sim) call cosp_lidar_only_cloud(Npoints,Ncolumns,Nlr, &
     164        if (cfg%Lradar_sim.AND.cfg%Llidar_sim) call cosp_lidar_only_cloud(Npoints,Ncolumns,Nlr, &
    165165                                    sglidar%temp_tot,sglidar%beta_tot,sglidar%betaperp_tot,sglidar%beta_mol,sgradar%Ze_tot, &
    166166                                    stradar%lidar_only_freq_cloud,stradar%radar_lidar_tcc)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_utils.F90

    r5160 r5185  
    8585                        mxratio(i,j,k)=mxratio(i,j,k)/rho
    8686                        ! Compute effective radius
    87 !                        if ((reff(i,j,k) <= 0.0).and.(flux(i,k) /= 0.0)) then
    88                         if ((reff(i,j,k) <= 0.0).and.(flux(i,k) > seuil)) then
     87!                        if ((reff(i,j,k) <= 0.0).AND.(flux(i,k) /= 0.0)) then
     88                        if ((reff(i,j,k) <= 0.0).AND.(flux(i,k) > seuil)) then
    8989                           lambda_x = (a_x*c_x*((rho0/rho)**g_x)*n_ax*gamma1/flux(i,k))**(1./delta)
    9090                           reff(i,j,k) = gamma_4_3_2/lambda_x

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_llnl_stats.F90

    r5158 r5185  
    7272            if (x(i,k,j) == R_GROUND) then
    7373               cosp_cfad(i,:,j) = R_UNDEF
    74             elseif ((x(i,k,j) >= xmin) .and. (x(i,k,j) <= xmax)) then
     74            elseif ((x(i,k,j) >= xmin) .AND. (x(i,k,j) <= xmax)) then
    7575               ibin = ceiling((x(i,k,j) - bmin)/bwidth)
    7676               if (ibin > Nbins) ibin = Nbins
    … …  
    8181      enddo  !k
    8282   enddo  !j
    83    where ((cosp_cfad /= R_UNDEF).and.(cosp_cfad /= 0.0)) cosp_cfad = cosp_cfad / Ncolumns
     83   where ((cosp_cfad /= R_UNDEF).AND.(cosp_cfad /= 0.0)) cosp_cfad = cosp_cfad / Ncolumns
    8484END FUNCTION COSP_CFAD
    8585
    … …  
    117117       DO j=Nlevels,1,-1 !top->surf
    118118        sc_ratio = beta_tot(pr,i,j)/beta_mol(pr,j)
    119         if ((sc_ratio .le. s_att) .and. (flag_sat .eq. 0)) flag_sat = j
     119        if ((sc_ratio .le. s_att) .AND. (flag_sat .eq. 0)) flag_sat = j
    120120        if (Ze_tot(pr,i,j) .lt. -30.) then  !radar can't detect cloud
    121121         if ( (sc_ratio .gt. s_cld) .or. (flag_sat .eq. j) ) then  !lidar sense cloud

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_lmd_ipsl_stats.F90

    r5160 r5185  
    146146      DO ic = 1, ncol
    147147        pnorm_c = pnorm(:,ic,:)
    148         where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 ))
     148        where ((pnorm_c.lt.xmax) .AND. (pmol.lt.xmax) .AND. (pmol.gt. 0.0 ))
    149149            x3d_c = pnorm_c/pmol
    150150        elsewhere
    … …  
    273273               DO i = 1, Npoints
    274274                  if (x(i,k,j) /= undef) then
    275                      if ((x(i,k,j).gt.srbval_ext(ib-1)).and.(x(i,k,j).le.srbval_ext(ib))) &
     275                     if ((x(i,k,j).gt.srbval_ext(ib-1)).AND.(x(i,k,j).le.srbval_ext(ib))) &
    276276                          cfad(i,ib,j) = cfad(i,ib,j) + 1.0
    277277                  else
    … …  
    421421
    422422! cloud detection at subgrid-scale:
    423          where ( (x(:,:,k).gt.S_cld) .and. (x(:,:,k).ne. undef) )
     423         where ( (x(:,:,k).gt.S_cld) .AND. (x(:,:,k).ne. undef) )
    424424           cldy(:,:,k)=1.0
    425425         elsewhere
    … …  
    428428
    429429! number of usefull sub-columns:
    430          where ( (x(:,:,k).gt.S_att) .and. (x(:,:,k).ne. undef)  )
     430         where ( (x(:,:,k).gt.S_att) .AND. (x(:,:,k).ne. undef)  )
    431431           srok(:,:,k)=1.0
    432432         elsewhere
    … …  
    462462           ! instead of height, for ice,liquid and all clouds
    463463           DO itemp=1,Ntemp
    464              if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
     464             if( (tmp(ip,k).ge.tempmod(itemp)).AND.(tmp(ip,k).lt.tempmod(itemp+1)) )then
    465465               lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1.
    466466             endif
    … …  
    470470         if (cldy(ip,ic,k).eq.1.) then
    471471           DO itemp=1,Ntemp
    472              if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
     472             if( (tmp(ip,k).ge.tempmod(itemp)).AND.(tmp(ip,k).lt.tempmod(itemp+1)) )then
    473473               lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1.
    474474             endif
    … …  
    478478         p1 = pplay(ip,k)
    479479
    480          if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high clouds
     480         if ( p1.gt.0. .AND. p1.lt.(440.*100.)) then ! high clouds
    481481            cldlay3(ip,ic) = MAX(cldlay3(ip,ic), cldy(ip,ic,k))
    482482            nsublay3(ip,ic) = MAX(nsublay3(ip,ic), srok(ip,ic,k))
    483          else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then  ! mid clouds
     483         else if(p1.ge.(440.*100.) .AND. p1.lt.(680.*100.)) then  ! mid clouds
    484484            cldlay2(ip,ic) = MAX(cldlay2(ip,ic), cldy(ip,ic,k))
    485485            nsublay2(ip,ic) = MAX(nsublay2(ip,ic), srok(ip,ic,k))
    … …  
    513513          if(srok(ip,ic,k).gt.0.)then
    514514          DO itemp=1,Ntemp
    515             if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
     515            if( (tmp(ip,k).ge.tempmod(itemp)).AND.(tmp(ip,k).lt.tempmod(itemp+1)) )then
    516516              lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1.
    517517            endif
    … …  
    521521          if(cldy(ip,ic,k).eq.1.)then
    522522          DO itemp=1,Ntemp
    523             if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
     523            if( (tmp(ip,k).ge.tempmod(itemp)).AND.(tmp(ip,k).lt.tempmod(itemp+1)) )then
    524524              lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1.
    525525            endif
    … …  
    529529          iz=1
    530530          p1 = pplay(ip,k)
    531           if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high clouds
     531          if ( p1.gt.0. .AND. p1.lt.(440.*100.)) then ! high clouds
    532532            iz=3
    533           else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then  ! mid clouds
     533          else if(p1.ge.(440.*100.) .AND. p1.lt.(680.*100.)) then  ! mid clouds
    534534            iz=2
    535535         endif
    … …  
    590590
    591591! Avoid zero values
    592     if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
     592    if( (cldy(i,ncol,nlev).eq.1.) .AND. (ATBperp(i,ncol,nlev).gt.0.) )then
    593593! Computation of the ATBperp along the phase discrimination line
    594594           ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + &
    … …  
    610610                                                    ! to classify the phase cloud
    611611                cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
    612                 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
     612                if ( p1.gt.0. .AND. p1.lt.(440.*100.)) then             ! high cloud
    613613               cldlayphase(i,ncol,3,2) = 1.
    614              else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
     614             else if(p1.ge.(440.*100.) .AND. p1.lt.(680.*100.)) then ! mid cloud
    615615                cldlayphase(i,ncol,2,2) = 1.
    616616         else                                                    ! low cloud
    … …  
    618618                endif
    619619                cldlayphase(i,ncol,4,5) = 1.                         ! tot cloud
    620              if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
     620             if ( p1.gt.0. .AND. p1.lt.(440.*100.)) then             ! high cloud
    621621               cldlayphase(i,ncol,3,5) = 1.
    622              else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
     622             else if(p1.ge.(440.*100.) .AND. p1.lt.(680.*100.)) then ! mid cloud
    623623                cldlayphase(i,ncol,2,5) = 1.
    624624         else                                                    ! low cloud
    … …  
    631631              tmpi(i,ncol,nlev)=tmp(i,nlev)
    632632                cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
    633              if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
     633             if ( p1.gt.0. .AND. p1.lt.(440.*100.)) then             ! high cloud
    634634               cldlayphase(i,ncol,3,1) = 1.
    635              else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
     635             else if(p1.ge.(440.*100.) .AND. p1.lt.(680.*100.)) then ! mid cloud
    636636                cldlayphase(i,ncol,2,1) = 1.
    637637         else                                                    ! low cloud
    … …  
    652652               tmpl(i,ncol,nlev)=tmp(i,nlev)
    653653                cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
    654              if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
     654             if ( p1.gt.0. .AND. p1.lt.(440.*100.)) then             ! high cloud
    655655                cldlayphase(i,ncol,3,2) = 1.
    656              else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
     656             else if(p1.ge.(440.*100.) .AND. p1.lt.(680.*100.)) then ! mid cloud
    657657                cldlayphase(i,ncol,2,2) = 1.
    658658         else                                                    ! low cloud
    … …  
    667667                                                    ! to classify the phase cloud
    668668                cldlayphase(i,ncol,4,4) = 1.                         ! tot cloud
    669              if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
     669             if ( p1.gt.0. .AND. p1.lt.(440.*100.)) then             ! high cloud
    670670                cldlayphase(i,ncol,3,4) = 1.
    671              else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
     671             else if(p1.ge.(440.*100.) .AND. p1.lt.(680.*100.)) then ! mid cloud
    672672                cldlayphase(i,ncol,2,4) = 1.
    673673         else                                                    ! low cloud
    … …  
    675675         endif
    676676                cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
    677             if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
     677            if ( p1.gt.0. .AND. p1.lt.(440.*100.)) then             ! high cloud
    678678                cldlayphase(i,ncol,3,1) = 1.
    679              else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
     679             else if(p1.ge.(440.*100.) .AND. p1.lt.(680.*100.)) then ! mid cloud
    680680                cldlayphase(i,ncol,2,1) = 1.
    681681         else                                                    ! low cloud
    … …  
    699699         p1 = pplay(i,nlev)
    700700
    701     if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
     701    if( (cldy(i,ncol,nlev).eq.1.) .AND. (ATBperp(i,ncol,nlev).gt.0.) )then
    702702! Phase discrimination line : ATBperp = ATB^5*alpha50 + ATB^4*beta50 + ATB^3*gamma50 + ATB^2*delta50
    703703!                                  + ATB*epsilon50 + zeta50
    … …  
    719719
    720720                cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
    721                if ( p1.gt.0. .and. p1.lt.(440.*100.)) then              ! high cloud
     721               if ( p1.gt.0. .AND. p1.lt.(440.*100.)) then              ! high cloud
    722722               cldlayphase(i,ncol,3,2) = 1.
    723              else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
     723             else if(p1.ge.(440.*100.) .AND. p1.lt.(680.*100.)) then ! mid cloud
    724724                cldlayphase(i,ncol,2,2) = 1.
    725725         else                                                    ! low cloud
    … …  
    728728
    729729                cldlayphase(i,ncol,4,5) = 1.                         ! tot cloud
    730              if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
     730             if ( p1.gt.0. .AND. p1.lt.(440.*100.)) then             ! high cloud
    731731               cldlayphase(i,ncol,3,5) = 1.
    732              else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
     732             else if(p1.ge.(440.*100.) .AND. p1.lt.(680.*100.)) then ! mid cloud
    733733                cldlayphase(i,ncol,2,5) = 1.
    734734         else                                                    ! low cloud
    … …  
    742742
    743743                 cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
    744             if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
     744            if ( p1.gt.0. .AND. p1.lt.(440.*100.)) then             ! high cloud
    745745               cldlayphase(i,ncol,3,1) = 1.
    746              else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
     746             else if(p1.ge.(440.*100.) .AND. p1.lt.(680.*100.)) then ! mid cloud
    747747                cldlayphase(i,ncol,2,1) = 1.
    748748         else                                                    ! low cloud
    … …  
    764764
    765765                cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
    766              if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
     766             if ( p1.gt.0. .AND. p1.lt.(440.*100.)) then             ! high cloud
    767767                cldlayphase(i,ncol,3,2) = 1.
    768              else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
     768             else if(p1.ge.(440.*100.) .AND. p1.lt.(680.*100.)) then ! mid cloud
    769769                cldlayphase(i,ncol,2,2) = 1.
    770770         else                                                    ! low cloud
    … …  
    779779
    780780                cldlayphase(i,ncol,4,4) = 1.                         ! tot cloud
    781              if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
     781             if ( p1.gt.0. .AND. p1.lt.(440.*100.)) then             ! high cloud
    782782                cldlayphase(i,ncol,3,4) = 1.
    783              else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
     783             else if(p1.ge.(440.*100.) .AND. p1.lt.(680.*100.)) then ! mid cloud
    784784                cldlayphase(i,ncol,2,4) = 1.
    785785         else                                                    ! low cloud
    … …  
    788788
    789789                cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
    790             if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
     790            if ( p1.gt.0. .AND. p1.lt.(440.*100.)) then             ! high cloud
    791791                cldlayphase(i,ncol,3,1) = 1.
    792              else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
     792             else if(p1.ge.(440.*100.) .AND. p1.lt.(680.*100.)) then ! mid cloud
    793793                cldlayphase(i,ncol,2,1) = 1.
    794794         else                                                    ! low cloud
    … …  
    826826
    827827                cldlayphase(i,ncol,4,3) = 1.                         ! tot cloud
    828           if ( p1.gt.0. .and. p1.lt.(440.*100.)) then              ! high cloud
     828          if ( p1.gt.0. .AND. p1.lt.(440.*100.)) then              ! high cloud
    829829             cldlayphase(i,ncol,3,3) = 1.
    830           else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then  ! mid cloud
     830          else if(p1.ge.(440.*100.) .AND. p1.lt.(680.*100.)) then  ! mid cloud
    831831             cldlayphase(i,ncol,2,3) = 1.
    832832      else                                                     ! low cloud
    … …  
    939939DO itemp=1,Ntemp
    940940if(tmpi(i,ncol,nlev).gt.0.)then
    941       if( (tmpi(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpi(i,ncol,nlev).lt.tempmod(itemp+1)) )then
     941      if( (tmpi(i,ncol,nlev).ge.tempmod(itemp)).AND.(tmpi(i,ncol,nlev).lt.tempmod(itemp+1)) )then
    942942        lidarcldtemp(i,itemp,2)=lidarcldtemp(i,itemp,2)+1.
    943943      endif
    944944elseif(tmpl(i,ncol,nlev).gt.0.)then
    945       if( (tmpl(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpl(i,ncol,nlev).lt.tempmod(itemp+1)) )then
     945      if( (tmpl(i,ncol,nlev).ge.tempmod(itemp)).AND.(tmpl(i,ncol,nlev).lt.tempmod(itemp+1)) )then
    946946        lidarcldtemp(i,itemp,3)=lidarcldtemp(i,itemp,3)+1.
    947947      endif
    948948elseif(tmpu(i,ncol,nlev).gt.0.)then
    949       if( (tmpu(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpu(i,ncol,nlev).lt.tempmod(itemp+1)) )then
     949      if( (tmpu(i,ncol,nlev).ge.tempmod(itemp)).AND.(tmpu(i,ncol,nlev).lt.tempmod(itemp+1)) )then
    950950        lidarcldtemp(i,itemp,4)=lidarcldtemp(i,itemp,4)+1.
    951951      endif
    … …  
    10421042    DO k=1,Nlevels
    10431043       ! Cloud detection at subgrid-scale:
    1044        where ( (x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
     1044       where ( (x(:,:,k) .gt. S_cld) .AND. (x(:,:,k) .ne. undef) )
    10451045          cldy(:,:,k)=1.0
    10461046       elsewhere
    … …  
    10481048       endwhere
    10491049       ! Fully attenuated layer detection at subgrid-scale:
    1050        where ( (x(:,:,k) .gt. 0.0) .and. (x(:,:,k) .lt. S_att_opaq) .and. (x(:,:,k) .ne. undef) )
     1050       where ( (x(:,:,k) .gt. 0.0) .AND. (x(:,:,k) .lt. S_att_opaq) .AND. (x(:,:,k) .ne. undef) )
    10511051          cldyopaq(:,:,k)=1.0
    10521052       elsewhere
    … …  
    10551055
    10561056       ! Number of useful sub-column layers:
    1057        where ( (x(:,:,k) .gt. S_att) .and. (x(:,:,k) .ne. undef) )
     1057       where ( (x(:,:,k) .gt. S_att) .AND. (x(:,:,k) .ne. undef) )
    10581058          srok(:,:,k)=1.0
    10591059       elsewhere
    … …  
    10611061       endwhere
    10621062       ! Number of useful sub-columns layers for z_opaque 3D fraction:
    1063        where ( (x(:,:,k) .gt. 0.0) .and. (x(:,:,k) .ne. undef) )
     1063       where ( (x(:,:,k) .gt. 0.0) .AND. (x(:,:,k) .ne. undef) )
    10641064          srokopaq(:,:,k)=1.0
    10651065       elsewhere
    … …  
    10941094
    10951095     ! Declaring non-opaque cloudy profiles as thin cloud profiles
    1096        if ( (cldlay(ip,ic,4) .eq. 1.0) .and. (cldlay(ip,ic,1) .eq. 0.0) ) then
     1096       if ( (cldlay(ip,ic,4) .eq. 1.0) .AND. (cldlay(ip,ic,1) .eq. 0.0) ) then
    10971097          cldlay(ip,ic,2)  =  1.0
    10981098        endif
    … …  
    11051105          DO k=2,Nlevels
    11061106     ! Declaring opaque cloud fraction and z_opaque altitude for 3D and 2D variables
    1107              if ( (cldy(ip,ic,k) .eq. 1.0) .and. (zopac .eq. 0.0) ) then
     1107             if ( (cldy(ip,ic,k) .eq. 1.0) .AND. (zopac .eq. 0.0) ) then
    11081108            lidarcldtype(ip,k-1,3) = lidarcldtype(ip,k-1,3) + 1.0
    11091109            cldlay(ip,ic,3)        = vgrid_z(k-1) !z_opaque altitude

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_modis_sim.F90

    r5158 r5185  
    249249    ! Initialize initial estimates for size retrievals
    250250
    251     if(any(cloudMask) .and. .not. useSimpleReScheme) then
     251    if(any(cloudMask) .AND. .not. useSimpleReScheme) then
    252252      g_w(:)  = get_g_nir(  phaseIsLiquid, trial_re_w(:))
    253253      w0_w(:) = get_ssa_nir(phaseIsLiquid, trial_re_w(:))
    … …  
    319319      end if
    320320    end do
    321     where((retrievedSize(:) < 0.).and.(retrievedSize(:) /= R_UNDEF)) retrievedSize(:) = 1.0e-06*re_fill
     321    where((retrievedSize(:) < 0.).AND.(retrievedSize(:) /= R_UNDEF)) retrievedSize(:) = 1.0e-06*re_fill
    322322
    323323    ! We use the ISCCP-derived CTP for low clouds, since the ISCCP simulator ICARUS
    … …  
    325325    !   Of course, ISCCP cloud top pressures are in mb.
    326326
    327     where(cloudMask(:) .and. retrievedCloudTopPressure(:) > CO2Slicing_PressureLimit) &
     327    where(cloudMask(:) .AND. retrievedCloudTopPressure(:) > CO2Slicing_PressureLimit) &
    328328      retrievedCloudTopPressure(:) = isccpCloudTopPressure * 100.
    329329   
    … …  
    475475    ! ########################################################################################
    476476    validRetrievalMask(1:nPoints,1:nSubCols) = particle_size(1:nPoints,1:nSubCols) > 0.
    477     cloudMask(1:nPoints,1:nSubCols) = phase(1:nPoints,1:nSubCols) /= phaseIsNone .and.       &
     477    cloudMask(1:nPoints,1:nSubCols) = phase(1:nPoints,1:nSubCols) /= phaseIsNone .AND.       &
    478478         validRetrievalMask(1:nPoints,1:nSubCols)
    479     waterCloudMask(1:nPoints,1:nSubCols) = phase(1:nPoints,1:nSubCols) == phaseIsLiquid .and. &
     479    waterCloudMask(1:nPoints,1:nSubCols) = phase(1:nPoints,1:nSubCols) == phaseIsLiquid .AND. &
    480480         validRetrievalMask(1:nPoints,1:nSubCols)
    481     iceCloudMask(1:nPoints,1:nSubCols)   = phase(1:nPoints,1:nSubCols) == phaseIsIce .and.    &
     481    iceCloudMask(1:nPoints,1:nSubCols)   = phase(1:nPoints,1:nSubCols) == phaseIsIce .AND.    &
    482482         validRetrievalMask(1:nPoints,1:nSubCols)
    483483
    … …  
    488488    Cloud_Fraction_Water_Mean(1:nPoints) = real(count(waterCloudMask, dim = 2))
    489489    Cloud_Fraction_Ice_Mean(1:nPoints)   = real(count(iceCloudMask,   dim = 2))
    490     Cloud_Fraction_High_Mean(1:nPoints)  = real(count(cloudMask .and. cloud_top_pressure <=          &
     490    Cloud_Fraction_High_Mean(1:nPoints)  = real(count(cloudMask .AND. cloud_top_pressure <=          &
    491491                                           highCloudPressureLimit, dim = 2))
    492     Cloud_Fraction_Low_Mean(1:nPoints)   = real(count(cloudMask .and. cloud_top_pressure >           &
     492    Cloud_Fraction_Low_Mean(1:nPoints)   = real(count(cloudMask .AND. cloud_top_pressure >           &
    493493                                           lowCloudPressureLimit,  dim = 2))
    494494    Cloud_Fraction_Mid_Mean(1:nPoints)   = Cloud_Fraction_Total_Mean(1:nPoints) - Cloud_Fraction_High_Mean(1:nPoints)&
    … …  
    653653    DO ij=2,nbin1+1
    654654       DO ik=2,nbin2+1
    655           jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .and. var1 .lt. bin1(ij) .and. &
    656                var2 .ge. bin2(ik-1) .and. var2 .lt. bin2(ik))       
     655          jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .AND. var1 .lt. bin1(ij) .AND. &
     656               var2 .ge. bin2(ik-1) .AND. var2 .lt. bin2(ik))
    657657       enddo
    658658    enddo
    … …  
    719719
    720720    validRetrievalMask(:, :) = particle_size(:, :) > 0.
    721     cloudMask      = phase(:, :) /= phaseIsNone   .and. validRetrievalMask(:, :)
    722     waterCloudMask = phase(:, :) == phaseIsLiquid .and. validRetrievalMask(:, :)
    723     iceCloudMask   = phase(:, :) == phaseIsIce    .and. validRetrievalMask(:, :)
     721    cloudMask      = phase(:, :) /= phaseIsNone   .AND. validRetrievalMask(:, :)
     722    waterCloudMask = phase(:, :) == phaseIsLiquid .AND. validRetrievalMask(:, :)
     723    iceCloudMask   = phase(:, :) == phaseIsIce    .AND. validRetrievalMask(:, :)
    724724
    725725    ! Use these as pixel counts at first
    … …  
    729729    Cloud_Fraction_Ice_Mean(:)   = real(count(iceCloudMask,   dim = 2))
    730730   
    731     Cloud_Fraction_High_Mean(:) = real(count(cloudMask .and. cloud_top_pressure <= highCloudPressureLimit, dim = 2))
    732     Cloud_Fraction_Low_Mean(:)  = real(count(cloudMask .and. cloud_top_pressure >  lowCloudPressureLimit,  dim = 2))
     731    Cloud_Fraction_High_Mean(:) = real(count(cloudMask .AND. cloud_top_pressure <= highCloudPressureLimit, dim = 2))
     732    Cloud_Fraction_Low_Mean(:)  = real(count(cloudMask .AND. cloud_top_pressure >  lowCloudPressureLimit,  dim = 2))
    733733    Cloud_Fraction_Mid_Mean(:)  = Cloud_Fraction_Total_Mean(:) - Cloud_Fraction_High_Mean(:) - Cloud_Fraction_Low_Mean(:)
    734734
    … …  
    780780    DO i = 1, numTauHistogramBins
    781781      where(cloudMask(:, :))
    782         tauMask(:, :, i) = optical_thickness(:, :) >= tauHistogramBoundaries(i) .and. &
     782        tauMask(:, :, i) = optical_thickness(:, :) >= tauHistogramBoundaries(i) .AND. &
    783783                           optical_thickness(:, :) <  tauHistogramBoundaries(i+1)
    784784      elsewhere
    … …  
    789789    DO i = 1, numPressureHistogramBins
    790790      where(cloudMask(:, :))
    791         pressureMask(:, :, i) = cloud_top_pressure(:, :) >= pressureHistogramBoundaries(i) .and. &
     791        pressureMask(:, :, i) = cloud_top_pressure(:, :) >= pressureHistogramBoundaries(i) .AND. &
    792792                                cloud_top_pressure(:, :) <  pressureHistogramBoundaries(i+1)
    793793      elsewhere
    … …  
    799799      DO j = 1, numTauHistogramBins
    800800        Optical_Thickness_vs_Cloud_Top_Pressure(:, j, i) = &
    801           real(count(tauMask(:, :, j) .and. pressureMask(:, :, i), dim = 2)) / real(nSubcols)
     801          real(count(tauMask(:, :, j) .AND. pressureMask(:, :, i), dim = 2)) / real(nSubcols)
    802802      end do
    803803    end do
    … …  
    936936
    937937! DJS2015: Remove unused piece of code     
    938 !      if(use_two_re_iterations .and. retrieve_re > 0.) then
     938!      if(use_two_re_iterations .AND. retrieve_re > 0.) then
    939939!        re_min = retrieve_re - delta_re
    940940!        re_max = retrieve_re + delta_re

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/phys_cosp.F90

    r5160 r5185  
    201201
    202202!!! Ici on modifie les cles logiques pour les outputs selon les champs actives dans les .xml
    203   if ((itap.gt.1).and.(first_write))then
     203  if ((itap.gt.1).AND.(first_write))then
    204204   
    205205    IF (using_xios) call read_xiosfieldactive(cfg)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/prec_scops.F

    r5099 r5185  
    192192          endif
    193193        enddo ! loop over ncol
    194         if ((flag_ls .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
     194        if ((flag_ls .eq. 0) .AND. (ilev .lt. nlev)) then ! possibility THREE
    195195        do ibox=1,ncol
    196196        if (frac_out(j,ibox,ilev+1) .eq. 1) then
    … …  
    229229        endif
    230230       enddo ! loop over ncol
    231         if ((flag_cv .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
     231        if ((flag_cv .eq. 0) .AND. (ilev .lt. nlev)) then ! possibility THREE
    232232        do ibox=1,ncol
    233233        if (frac_out(j,ibox,ilev+1) .eq. 2) then

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/radar_simulator.F90

    r5160 r5185  
    187187      hydro = .false.
    188188      DO j=1,hp%nhclass
    189         if ((hm_matrix(j,pr,k) > 1E-12) .and. (hp%dtype(j) > 0)) then
     189        if ((hm_matrix(j,pr,k) > 1E-12) .AND. (hp%dtype(j) > 0)) then
    190190          hydro = .true.
    191191          exit
    … …  
    298298            else
    299299              ! I assume here that water phase droplets are spheres.
    300               ! hp%rho should be ~ 1000  or hp%apm=524 .and. hp%bpm=3
     300              ! hp%rho should be ~ 1000  or hp%apm=524 .AND. hp%bpm=3
    301301              Deq = Di
    302302            endif
    … …  
    311311            ! NOTE: if .not. DO_LUT_TEST, then you are checking the LUT approximation
    312312            ! not just the DSD representation given by Ni
    313             if(Np_matrix(tp,pr,k)>0 .and. DO_NP_TEST ) then
     313            if(Np_matrix(tp,pr,k)>0 .AND. DO_NP_TEST ) then
    314314              Np = path_integral(Ni,Di,1,ns-1)/rho_a*1E6
    315315              ! Note: Representation is not great or small Re < 2
    … …  
    326326            ! LUT test code
    327327            ! This segment of code compares full calculation to scaling result
    328             if ( hp%Z_scale_flag(tp,itt,iRe_type) .and. DO_LUT_TEST )  then
     328            if ( hp%Z_scale_flag(tp,itt,iRe_type) .AND. DO_LUT_TEST )  then
    329329              scale_factor=rho_a*hm_matrix(tp,pr,k)
    330330              ! if more than 2 dBZe difference print error message/parameters.
    … …  
    400400        g_to_vol(pr,k) = g_to_vol_in(pr,k)
    401401      else
    402         if ( (hp%use_gas_abs == 1) .or. ((hp%use_gas_abs == 2) .and. (pr == 1)) ) then
     402        if ( (hp%use_gas_abs == 1) .or. ((hp%use_gas_abs == 2) .AND. (pr == 1)) ) then
    403403          g_vol(pr,k) = gases(p_matrix(pr,k),t_kelvin,rh_matrix(pr,k),hp%freq)
    404404          if (d_gate==1) then
    … …  
    428428
    429429      ! Compute Rayleigh reflectivity, and full, attenuated reflectivity
    430       if ((hp%do_ray == 1) .and. (z_ray(pr,k) > 0)) then
     430      if ((hp%do_ray == 1) .AND. (z_ray(pr,k) > 0)) then
    431431        Ze_ray(pr,k) = 10*log10(z_ray(pr,k))
    432432      else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/scops.F

    r5099 r5185  
    236236              if (threshold(j,ibox)
    237237     &          .lt.min(tca(j,ilev-1),tca(j,ilev))
    238      &          .and.(threshold(j,ibox).gt.conv(j,ilev))) then
     238     &          .AND.(threshold(j,ibox).gt.conv(j,ilev))) then
    239239                   maxosc(j,ibox)= 1
    240240              else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/zeff.F90

    r5158 r5185  
    9999   
    100100    correct_for_rho = 0
    101     if ((ice == 1) .and. (minval(rho_e) >= 0)) correct_for_rho = 1
     101    if ((ice == 1) .AND. (minval(rho_e) >= 0)) correct_for_rho = 1
    102102   
    103103!   :: correct refractive index for ice density if needed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/MISR_simulator.F90

    r5159 r5185  
    110110          DO ilev=1,nlev
    111111             ! If there a cloud, start the counter and store this height
    112              if(thres_crossed_MISR .eq. 0 .and. dtau(j,ibox,ilev) .gt. 0.) then
     112             if(thres_crossed_MISR .eq. 0 .AND. dtau(j,ibox,ilev) .gt. 0.) then
    113113                ! First encountered a "cloud"
    114114                thres_crossed_MISR = 1 
    … …  
    116116             endif
    117117
    118              if( thres_crossed_MISR .lt. 99 .and. thres_crossed_MISR .gt. 0 ) then
     118             if( thres_crossed_MISR .lt. 99 .AND. thres_crossed_MISR .gt. 0 ) then
    119119                if( dtau(j,ibox,ilev) .eq. 0.) then
    120120                   ! We have come to the end of the current cloud layer without yet
    … …  
    129129                ! current layer cloud top to the current level then MISR will like
    130130                ! see a top below the top of the current layer.
    131                 if( dtau(j,ibox,ilev).gt.0 .and. (cloud_dtau-dtau(j,ibox,ilev)) .lt. 1) then
     131                if( dtau(j,ibox,ilev).gt.0 .AND. (cloud_dtau-dtau(j,ibox,ilev)) .lt. 1) then
    132132                   if(dtau(j,ibox,ilev) .lt. 1 .or. ilev.eq.1 .or. ilev.eq.nlev) then
    133133                      ! MISR will likely penetrate to some point within this layer ... the middle
    … …  
    142142               
    143143                ! Check for a distinctive water layer
    144                 if(dtau(j,ibox,ilev) .gt. 1 .and. at(j,ilev) .gt. 273 ) then
     144                if(dtau(j,ibox,ilev) .gt. 1 .AND. at(j,ilev) .gt. 273 ) then
    145145                   ! Must be a water cloud, take this as CTH level
    146146                   thres_crossed_MISR=99
    … …  
    191191!       ! Adjust based on neightboring points.
    192192!       do j=2,npoints-1   
    193 !          if(box_MISR_ztop(j-1,1) .gt. 0                             .and. &
    194 !             box_MISR_ztop(j+1,1) .gt. 0                             .and. &
    195 !             abs(box_MISR_ztop(j-1,1)-box_MISR_ztop(j+1,1)) .lt. 500 .and. &
     193!          if(box_MISR_ztop(j-1,1) .gt. 0                             .AND. &
     194!             box_MISR_ztop(j+1,1) .gt. 0                             .AND. &
     195!             abs(box_MISR_ztop(j-1,1)-box_MISR_ztop(j+1,1)) .lt. 500 .AND. &
    196196!             box_MISR_ztop(j,1) .lt. box_MISR_ztop(j+1,1)) then
    197197!             box_MISR_ztop(j,1) = box_MISR_ztop(j+1,1)   
    … …  
    202202!       do j=1,npoints
    203203!          do ibox=2,ncol-1 
    204 !                 if(box_MISR_ztop(j,ibox-1) .gt. 0                                .and. &
    205 !                 box_MISR_ztop(j,ibox+1) .gt. 0                                .and. &
    206 !                 abs(box_MISR_ztop(j,ibox-1)-box_MISR_ztop(j,ibox+1)) .lt. 500 .and. &
     204!                 if(box_MISR_ztop(j,ibox-1) .gt. 0                                .AND. &
     205!                 box_MISR_ztop(j,ibox+1) .gt. 0                                .AND. &
     206!                 abs(box_MISR_ztop(j,ibox-1)-box_MISR_ztop(j,ibox+1)) .lt. 500 .AND. &
    207207!                 box_MISR_ztop(j,ibox) .lt. box_MISR_ztop(j,ibox+1)) then
    208208!                 box_MISR_ztop(j,ibox) = box_MISR_ztop(j,ibox+1)   

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp.F90

    r5158 r5185  
    381381    ! 1) Determine if using full inputs or subset
    382382    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    383     if (present(start_idx) .and. present(stop_idx)) then
     383    if (present(start_idx) .AND. present(stop_idx)) then
    384384       ij=start_idx
    385385       ik=stop_idx
    … …  
    932932
    933933       ! Check if there is any value slightly greater than 1
    934        where ((cospOUT%isccp_totalcldarea > 1.0-1.e-5) .and.                             &
     934       where ((cospOUT%isccp_totalcldarea > 1.0-1.e-5) .AND.                             &
    935935              (cospOUT%isccp_totalcldarea < 1.0+1.e-5))
    936936              cospOUT%isccp_totalcldarea = 1.0

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_optics.F90

    r5158 r5185  
    306306    ! Do we need to generate optical inputs for Parasol simulator?
    307307    lparasol = .false.
    308     if (present(tautot_S_liq) .and. present(tautot_S_ice)) lparasol = .true.
     308    if (present(tautot_S_liq) .AND. present(tautot_S_ice)) lparasol = .true.
    309309   
    310310    ! Are optical-depths and backscatter coefficients for ice and liquid requested?
    311311    lphaseoptics=.false.
    312     if (present(betatot_ice) .and. present(betatot_liq) .and. present(tautot_liq) .and. &
     312    if (present(betatot_ice) .AND. present(betatot_liq) .AND. present(tautot_liq) .AND. &
    313313         present(tautot_ice)) lphaseoptics=.true.
    314314

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_stats.F90

    r5158 r5185  
    217217          DO j=1,Nlevels
    218218             sc_ratio = beta_tot(pr,i,j)/beta_mol(pr,j)
    219              if ((sc_ratio .le. s_att) .and. (flag_sat .eq. 0)) flag_sat = j
     219             if ((sc_ratio .le. s_att) .AND. (flag_sat .eq. 0)) flag_sat = j
    220220             if (Ze_tot(pr,i,j) .lt. -30.) then  !radar can't detect cloud
    221221                if ( (sc_ratio .gt. s_cld) .or. (flag_sat .eq. j) ) then  !lidar sense cloud
    … …  
    267267   
    268268    DO ij=2,Nbins+1
    269        hist1D(ij-1) = count(var .ge. bins(ij-1) .and. var .lt. bins(ij))
     269       hist1D(ij-1) = count(var .ge. bins(ij-1) .AND. var .lt. bins(ij))
    270270       if (count(var .eq. R_GROUND) .ge. 1) hist1D(ij-1)=R_UNDEF
    271271    enddo
    … …  
    300300    DO ij=2,nbin1+1
    301301       DO ik=2,nbin2+1
    302           jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .and. var1 .lt. bin1(ij) .and. &
    303                var2 .ge. bin2(ik-1) .and. var2 .lt. bin2(ik))       
     302          jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .AND. var1 .lt. bin1(ij) .AND. &
     303               var2 .ge. bin2(ik-1) .AND. var2 .lt. bin2(ik))
    304304       enddo
    305305    enddo

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_utils.F90

    r5158 r5185  
    8585                        mxratio(i,j,k)=mxratio(i,j,k)/rho
    8686                        ! Compute effective radius
    87 !                        if ((reff(i,j,k) <= 0._wp).and.(flux(i,k) /= 0._wp)) then
    88                          if ((reff(i,j,k) <= 0._wp).and.(flux(i,k) > seuil)) then
     87!                        if ((reff(i,j,k) <= 0._wp).AND.(flux(i,k) /= 0._wp)) then
     88                         if ((reff(i,j,k) <= 0._wp).AND.(flux(i,k) > seuil)) then
    8989                           lambda_x = (a_x*c_x*((rho0/rho)**g_x)*n_ax*gamma1/flux(i,k))**(1._wp/delta)
    9090                           reff(i,j,k) = gamma_4_3_2/lambda_x

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/icarus.F90

    r5159 r5185  
    232232
    233233       DO ilev=1,nlev
    234           where(pfull(1:npoints,ilev) .lt. 40000. .and. &
    235                 pfull(1:npoints,ilev) .gt.  5000. .and. &
     234          where(pfull(1:npoints,ilev) .lt. 40000. .AND. &
     235                pfull(1:npoints,ilev) .gt.  5000. .AND. &
    236236                at(1:npoints,ilev)    .lt. attropmin(1:npoints))
    237237             ptrop(1:npoints)     = pfull(1:npoints,ilev)
    … …  
    244244       DO ilev=1,nlev
    245245          atmax(1:npoints) = merge(at(1:npoints,ilev),atmax(1:npoints),&
    246                at(1:npoints,ilev) .gt. atmax(1:npoints) .and. ilev  .ge. itrop(1:npoints))
     246               at(1:npoints,ilev) .gt. atmax(1:npoints) .AND. ilev  .ge. itrop(1:npoints))
    247247       enddo
    248248    end if
    … …  
    350350          if (isccp_top_height .eq. 1) then
    351351             DO j=1,npoints
    352                 if (transmax(j) .gt. 0.001 .and.  transmax(j) .le. 0.9999999) then
     352                if (transmax(j) .gt. 0.001 .AND.  transmax(j) .le. 0.9999999) then
    353353                   fluxtopinit(j) = fluxtop(j,ibox)
    354354                   tauir(j) = tau(j,ibox)/2.13_wp
    … …  
    358358                DO j=1,npoints
    359359                   if (tau(j,ibox) .gt. (tauchk)) then
    360                       if (transmax(j) .gt. 0.001 .and.  transmax(j) .le. 0.9999999) then
     360                      if (transmax(j) .gt. 0.001 .AND.  transmax(j) .le. 0.9999999) then
    361361                         emcld(j,ibox) = 1._wp - exp(-1._wp * tauir(j)  )
    362362                         fluxtop(j,ibox) = fluxtopinit(j) - ((1.-emcld(j,ibox))*fluxtop_clrsky(j))
    … …  
    375375          where(tau(1:npoints,ibox) .gt. tauchk)
    376376             tb(1:npoints,ibox)= 1307.27_wp/ (log(1. + (1._wp/fluxtop(1:npoints,ibox))))
    377              where (isccp_top_height .eq. 1 .and. tauir(1:npoints) .lt. taumin(1:npoints))
     377             where (isccp_top_height .eq. 1 .AND. tauir(1:npoints) .lt. taumin(1:npoints))
    378378                tb(1:npoints,ibox) = attrop(1:npoints) - 5._wp
    379379                tau(1:npoints,ibox) = 2.13_wp*taumin(1:npoints)
    … …  
    406406             ilev = merge(nlev-k1,k1,isccp_top_height_direction .eq. 2)       
    407407             DO j=1,npoints
    408                 if (ilev           .ge. itrop(j)     .and. &
    409                      ((at(j,ilev)  .ge. tb(j,ibox)   .and. & 
     408                if (ilev           .ge. itrop(j)     .AND. &
     409                     ((at(j,ilev)  .ge. tb(j,ibox)   .AND. &
    410410                      at(j,ilev+1) .le. tb(j,ibox))  .or.  &
    411                       (at(j,ilev)  .le. tb(j,ibox)   .and. &
     411                      (at(j,ilev)  .le. tb(j,ibox)   .AND. &
    412412                      at(j,ilev+1) .ge. tb(j,ibox)))) then
    413413                   nmatch(j)=nmatch(j)+1
    … …  
    441441          ptop(1:npoints,ibox)=0.
    442442          DO ilev=1,nlev
    443              where((ptop(1:npoints,ibox) .eq. 0. ) .and.(frac_out(1:npoints,ibox,ilev) .ne. 0))
     443             where((ptop(1:npoints,ibox) .eq. 0. ) .AND.(frac_out(1:npoints,ibox,ilev) .ne. 0))
    444444                ptop(1:npoints,ibox)=phalf(1:npoints,ilev)
    445445                levmatch(1:npoints,ibox)=ilev
    … …  
    460460    DO ibox=1,ncol
    461461       DO j=1,npoints
    462           if (tau(j,ibox) .gt. (tauchk) .and. ptop(j,ibox) .gt. 0.) then
     462          if (tau(j,ibox) .gt. (tauchk) .AND. ptop(j,ibox) .gt. 0.) then
    463463             if (sunlit(j).eq.1 .or. isccp_top_height .eq. 3) then
    464464                boxtau(j,ibox) = tau(j,ibox)
    … …  
    561561    DO j=1,npoints
    562562       ! Subcolumns that are cloudy(true) and not(false)
    563        box_cloudy2(1:ncol) = merge(.true.,.false.,boxtau(j,1:ncol) .gt. tauchk .and. boxptop(j,1:ncol) .gt. 0.)
     563       box_cloudy2(1:ncol) = merge(.true.,.false.,boxtau(j,1:ncol) .gt. tauchk .AND. boxptop(j,1:ncol) .gt. 0.)
    564564
    565565       ! Compute joint histogram and column quantities for points that are sunlit and cloudy
    … …  
    572572         
    573573          ! Column cloud area
    574           totalcldarea(j) = real(count(box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) .gt. isccp_taumin))/ncol
     574          totalcldarea(j) = real(count(box_cloudy2(1:ncol) .AND. boxtau(j,1:ncol) .gt. isccp_taumin))/ncol
    575575             
    576576          ! Subcolumn cloud albedo
    577577          !albedocld(j,1:ncol) = merge((boxtau(j,1:ncol)**0.895_wp)/((boxtau(j,1:ncol)**0.895_wp)+6.82_wp),&
    578           !     0._wp,box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) .gt. isccp_taumin)
    579           where(box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) .gt. isccp_taumin)
     578          !     0._wp,box_cloudy2(1:ncol) .AND. boxtau(j,1:ncol) .gt. isccp_taumin)
     579          where(box_cloudy2(1:ncol) .AND. boxtau(j,1:ncol) .gt. isccp_taumin)
    580580             albedocld(j,1:ncol) = (boxtau(j,1:ncol)**0.895_wp)/((boxtau(j,1:ncol)**0.895_wp)+6.82_wp)
    581581          elsewhere
    … …  
    587587         
    588588          ! Column cloud top pressure
    589           meanptop(j) = sum(boxptop(j,1:ncol),box_cloudy2(1:ncol) .and. boxtau(j,1:ncol) .gt. isccp_taumin)/ncol
     589          meanptop(j) = sum(boxptop(j,1:ncol),box_cloudy2(1:ncol) .AND. boxtau(j,1:ncol) .gt. isccp_taumin)/ncol
    590590       endif
    591591    enddo

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lidar_simulator.F90

    r5160 r5185  
    152152    ! Phase optics?
    153153    lphaseoptics=.false.
    154     if (present(betatot_ice) .and. present(betatot_liq) .and. present(tautot_liq) .and. &
     154    if (present(betatot_ice) .AND. present(betatot_liq) .AND. present(tautot_liq) .AND. &
    155155         present(tautot_ice)) lphaseoptics=.true.
    156156   
    … …  
    400400       DO ic = 1, ncol
    401401          pnorm_c = pnormFlip(:,ic,:)
    402           where ((pnorm_c .lt. xmax) .and. (betamolFlip(:,1,:) .lt. xmax) .and.          &
     402          where ((pnorm_c .lt. xmax) .AND. (betamolFlip(:,1,:) .lt. xmax) .AND.          &
    403403                (betamolFlip(:,1,:) .gt. 0.0 ))
    404404             x3d_c = pnorm_c/betamolFlip(:,1,:)
    … …  
    429429       DO ic = 1, ncol
    430430          pnorm_c = pnorm(:,ic,:)
    431           where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 ))
     431          where ((pnorm_c.lt.xmax) .AND. (pmol.lt.xmax) .AND. (pmol.gt. 0.0 ))
    432432             x3d_c = pnorm_c/pmol
    433433          elsewhere
    … …  
    650650    DO k=1,Nlevels
    651651       ! Cloud detection at subgrid-scale:
    652        where ((x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
     652       where ((x(:,:,k) .gt. S_cld) .AND. (x(:,:,k) .ne. undef) )
    653653          cldy(:,:,k)=1._wp
    654654       elsewhere
    … …  
    657657       
    658658       ! Number of usefull sub-columns:
    659        where ((x(:,:,k) .gt. S_att) .and. (x(:,:,k) .ne. undef) )
     659       where ((x(:,:,k) .gt. S_att) .AND. (x(:,:,k) .ne. undef) )
    660660          srok(:,:,k)=1._wp
    661661       elsewhere
    … …  
    679679             if(srok(ip,ic,k).gt.0.)then
    680680                DO itemp=1,Ntemp
    681                    if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
     681                   if( (tmp(ip,k).ge.tempmod(itemp)).AND.(tmp(ip,k).lt.tempmod(itemp+1)) )then
    682682                      lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1._wp
    683683                   endif
    … …  
    687687             if(cldy(ip,ic,k).eq.1.)then
    688688                DO itemp=1,Ntemp
    689                    if( (tmp(ip,k) .ge. tempmod(itemp)).and.(tmp(ip,k) .lt. tempmod(itemp+1)) )then
     689                   if( (tmp(ip,k) .ge. tempmod(itemp)).AND.(tmp(ip,k) .lt. tempmod(itemp+1)) )then
    690690                      lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1._wp
    691691                   endif
    … …  
    695695             iz=1
    696696             p1 = pplay(ip,k)
    697              if ( p1.gt.0. .and. p1.lt.(440._wp*100._wp)) then ! high clouds
     697             if ( p1.gt.0. .AND. p1.lt.(440._wp*100._wp)) then ! high clouds
    698698                iz=3
    699              else if(p1.ge.(440._wp*100._wp) .and. p1.lt.(680._wp*100._wp)) then ! mid clouds
     699             else if(p1.ge.(440._wp*100._wp) .AND. p1.lt.(680._wp*100._wp)) then ! mid clouds
    700700                iz=2
    701701             endif
    … …  
    748748
    749749             ! Avoid zero values
    750              if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
     750             if( (cldy(i,ncol,nlev).eq.1.) .AND. (ATBperp(i,ncol,nlev).gt.0.) )then
    751751                ! Computation of the ATBperp along the phase discrimination line
    752752                ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + &
    … …  
    767767                                                                              ! to classify the phase cloud
    768768                      cldlayphase(i,ncol,4,2) = 1. ! tot cloud
    769                       if (p1 .gt. 0. .and. p1.lt.(440._wp*100._wp)) then ! high cloud
     769                      if (p1 .gt. 0. .AND. p1.lt.(440._wp*100._wp)) then ! high cloud
    770770                         cldlayphase(i,ncol,3,2) = 1._wp
    771                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then ! mid cloud
     771                      else if(p1 .ge. (440._wp*100._wp) .AND. p1 .lt. (680._wp*100._wp)) then ! mid cloud
    772772                         cldlayphase(i,ncol,2,2) = 1._wp
    773773                      else ! low cloud
    … …  
    776776                      cldlayphase(i,ncol,4,5) = 1._wp ! tot cloud
    777777                      ! High cloud
    778                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     778                      if (p1 .gt. 0. .AND. p1 .lt. (440._wp*100._wp)) then
    779779                         cldlayphase(i,ncol,3,5) = 1._wp
    780780                      ! Middle cloud
    781                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     781                      else if(p1 .ge. (440._wp*100._wp) .AND. p1 .lt. (680._wp*100._wp)) then
    782782                         cldlayphase(i,ncol,2,5) = 1._wp
    783783                      ! Low cloud
    … …  
    791791                      cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud
    792792                      ! High cloud
    793                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     793                      if (p1 .gt. 0. .AND. p1 .lt. (440._wp*100._wp)) then
    794794                         cldlayphase(i,ncol,3,1) = 1._wp
    795795                      ! Middle cloud   
    796                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     796                      else if(p1 .ge. (440._wp*100._wp) .AND. p1 .lt. (680._wp*100._wp)) then
    797797                         cldlayphase(i,ncol,2,1) = 1._wp
    798798                      ! Low cloud
    … …  
    811811                      cldlayphase(i,ncol,4,2) = 1._wp ! tot cloud
    812812                      ! High cloud
    813                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     813                      if (p1 .gt. 0. .AND. p1 .lt. (440._wp*100._wp)) then
    814814                         cldlayphase(i,ncol,3,2) = 1._wp
    815815                      ! Middle cloud   
    816                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     816                      else if(p1 .ge. (440._wp*100._wp) .AND. p1 .lt. (680._wp*100._wp)) then
    817817                         cldlayphase(i,ncol,2,2) = 1._wp
    818818                      ! Low cloud   
    … …  
    827827                      cldlayphase(i,ncol,4,4) = 1._wp ! tot cloud
    828828                      ! High cloud
    829                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     829                      if (p1 .gt. 0. .AND. p1 .lt. (440._wp*100._wp)) then
    830830                         cldlayphase(i,ncol,3,4) = 1._wp
    831831                      ! Middle cloud   
    832                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     832                      else if(p1 .ge. (440._wp*100._wp) .AND. p1 .lt. (680._wp*100._wp)) then
    833833                         cldlayphase(i,ncol,2,4) = 1._wp
    834834                      ! Low cloud
    … …  
    838838                      cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud
    839839                      ! High cloud
    840                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     840                      if (p1 .gt. 0. .AND. p1 .lt. (440._wp*100._wp)) then
    841841                         cldlayphase(i,ncol,3,1) = 1._wp
    842842                      ! Middle cloud   
    843                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     843                      else if(p1 .ge. (440._wp*100._wp) .AND. p1 .lt. (680._wp*100._wp)) then
    844844                         cldlayphase(i,ncol,2,1) = 1._wp
    845845                      ! Low cloud   
    … …  
    859859             p1 = pplay(i,nlev)
    860860
    861              if((cldy(i,ncol,nlev) .eq. 1.) .and. (ATBperp(i,ncol,nlev) .gt. 0.) )then
     861             if((cldy(i,ncol,nlev) .eq. 1.) .AND. (ATBperp(i,ncol,nlev) .gt. 0.) )then
    862862                ! Computation of the ATBperp of the phase discrimination line
    863863                ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + &
    … …  
    875875                      cldlayphase(i,ncol,4,2) = 1._wp ! tot cloud
    876876                      ! High cloud
    877                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     877                      if (p1 .gt. 0. .AND. p1 .lt. (440._wp*100._wp)) then
    878878                         cldlayphase(i,ncol,3,2) = 1._wp
    879879                      ! Middle cloud   
    880                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     880                      else if(p1 .ge. (440._wp*100._wp) .AND. p1 .lt. (680._wp*100._wp)) then
    881881                         cldlayphase(i,ncol,2,2) = 1._wp
    882882                      ! Low cloud
    … …  
    887887                      cldlayphase(i,ncol,4,5) = 1. ! tot cloud
    888888                      ! High cloud
    889                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     889                      if (p1 .gt. 0. .AND. p1 .lt. (440._wp*100._wp)) then
    890890                         cldlayphase(i,ncol,3,5) = 1._wp
    891891                      ! Middle cloud   
    892                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     892                      else if(p1 .ge. (440._wp*100._wp) .AND. p1 .lt. (680._wp*100._wp)) then
    893893                         cldlayphase(i,ncol,2,5) = 1._wp
    894894                      ! Low cloud   
    … …  
    902902                      cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud
    903903                      ! High cloud
    904                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     904                      if (p1 .gt. 0. .AND. p1 .lt. (440._wp*100._wp)) then
    905905                         cldlayphase(i,ncol,3,1) = 1._wp
    906906                      ! Middle cloud   
    907                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt.(680._wp*100._wp)) then
     907                      else if(p1 .ge. (440._wp*100._wp) .AND. p1 .lt.(680._wp*100._wp)) then
    908908                         cldlayphase(i,ncol,2,1) = 1._wp
    909909                      ! Low cloud   
    … …  
    923923                      cldlayphase(i,ncol,4,2) = 1._wp ! tot cloud
    924924                      ! High cloud
    925                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     925                      if (p1 .gt. 0. .AND. p1 .lt. (440._wp*100._wp)) then
    926926                         cldlayphase(i,ncol,3,2) = 1._wp
    927927                      ! Middle cloud   
    928                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     928                      else if(p1 .ge. (440._wp*100._wp) .AND. p1 .lt. (680._wp*100._wp)) then
    929929                         cldlayphase(i,ncol,2,2) = 1._wp
    930930                      ! Low cloud   
    … …  
    939939                      cldlayphase(i,ncol,4,4) = 1._wp ! tot cloud
    940940                      ! High cloud
    941                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     941                      if (p1 .gt. 0. .AND. p1 .lt. (440._wp*100._wp)) then
    942942                         cldlayphase(i,ncol,3,4) = 1._wp
    943943                      ! Middle   
    944                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     944                      else if(p1 .ge. (440._wp*100._wp) .AND. p1 .lt. (680._wp*100._wp)) then
    945945                         cldlayphase(i,ncol,2,4) = 1._wp
    946946                      ! Low cloud   
    … …  
    951951                      cldlayphase(i,ncol,4,1) = 1._wp ! tot cloud
    952952                      ! High cloud
    953                       if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     953                      if (p1 .gt. 0. .AND. p1 .lt. (440._wp*100._wp)) then
    954954                         cldlayphase(i,ncol,3,1) = 1._wp
    955955                      ! Middle cloud   
    956                       else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     956                      else if(p1 .ge. (440._wp*100._wp) .AND. p1 .lt. (680._wp*100._wp)) then
    957957                         cldlayphase(i,ncol,2,1) = 1._wp
    958958                      ! Low cloud   
    … …  
    986986                   cldlayphase(i,ncol,4,3) = 1._wp ! tot cloud
    987987                   ! High cloud
    988                    if (p1 .gt. 0. .and. p1 .lt. (440._wp*100._wp)) then
     988                   if (p1 .gt. 0. .AND. p1 .lt. (440._wp*100._wp)) then
    989989                      cldlayphase(i,ncol,3,3) = 1._wp
    990990                   ! Middle cloud   
    991                    else if(p1 .ge. (440._wp*100._wp) .and. p1 .lt. (680._wp*100._wp)) then
     991                   else if(p1 .ge. (440._wp*100._wp) .AND. p1 .lt. (680._wp*100._wp)) then
    992992                      cldlayphase(i,ncol,2,3) = 1._wp
    993993                   ! Low cloud   
    … …  
    10871087             DO itemp=1,Ntemp
    10881088                if(tmpi(i,ncol,nlev).gt.0.)then
    1089                    if((tmpi(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpi(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
     1089                   if((tmpi(i,ncol,nlev) .ge. tempmod(itemp)) .AND. (tmpi(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
    10901090                      lidarcldtemp(i,itemp,2)=lidarcldtemp(i,itemp,2)+1._wp
    10911091                   endif
    10921092                elseif(tmpl(i,ncol,nlev) .gt. 0.)then
    1093                    if((tmpl(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpl(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
     1093                   if((tmpl(i,ncol,nlev) .ge. tempmod(itemp)) .AND. (tmpl(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
    10941094                      lidarcldtemp(i,itemp,3)=lidarcldtemp(i,itemp,3)+1._wp
    10951095                   endif
    10961096                elseif(tmpu(i,ncol,nlev) .gt. 0.)then
    1097                    if((tmpu(i,ncol,nlev) .ge. tempmod(itemp)) .and. (tmpu(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
     1097                   if((tmpu(i,ncol,nlev) .ge. tempmod(itemp)) .AND. (tmpu(i,ncol,nlev) .lt. tempmod(itemp+1)) )then
    10981098                      lidarcldtemp(i,itemp,4)=lidarcldtemp(i,itemp,4)+1._wp
    10991099                   endif
    … …  
    11931193    DO k=1,Nlevels
    11941194       ! Cloud detection at subgrid-scale:
    1195        where ((x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
     1195       where ((x(:,:,k) .gt. S_cld) .AND. (x(:,:,k) .ne. undef) )
    11961196          cldy(:,:,k)=1._wp
    11971197       elsewhere
    … …  
    12001200       
    12011201       ! Number of usefull sub-columns:
    1202        where ((x(:,:,k) .gt. S_att) .and. (x(:,:,k) .ne. undef) )
     1202       where ((x(:,:,k) .gt. S_att) .AND. (x(:,:,k) .ne. undef) )
    12031203          srok(:,:,k)=1._wp
    12041204       elsewhere
    … …  
    12161216             iz=1
    12171217             p1 = pplay(ip,k)
    1218              if ( p1.gt.0. .and. p1.lt.(440._wp*100._wp)) then ! high clouds
     1218             if ( p1.gt.0. .AND. p1.lt.(440._wp*100._wp)) then ! high clouds
    12191219                iz=3
    1220              else if(p1.ge.(440._wp*100._wp) .and. p1.lt.(680._wp*100._wp)) then ! mid clouds
     1220             else if(p1.ge.(440._wp*100._wp) .AND. p1.lt.(680._wp*100._wp)) then ! mid clouds
    12211221                iz=2
    12221222             endif
    … …  
    13441344    DO k=1,Nlevels
    13451345       ! Cloud detection at subgrid-scale:
    1346        where ( (x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
     1346       where ( (x(:,:,k) .gt. S_cld) .AND. (x(:,:,k) .ne. undef) )
    13471347          cldy(:,:,k)=1._wp
    13481348       elsewhere
    … …  
    13501350       endwhere
    13511351       ! Fully attenuated layer detection at subgrid-scale:
    1352        where ( (x(:,:,k) .lt. S_att_opaq) .and. (x(:,:,k) .ge. 0.) .and. (x(:,:,k) .ne. undef) ) !DEBUG
     1352       where ( (x(:,:,k) .lt. S_att_opaq) .AND. (x(:,:,k) .ge. 0.) .AND. (x(:,:,k) .ne. undef) ) !DEBUG
    13531353          cldyopaq(:,:,k)=1._wp
    13541354       elsewhere
    … …  
    13581358
    13591359       ! Number of usefull sub-column layers:
    1360        where ( (x(:,:,k) .gt. S_att) .and. (x(:,:,k) .ne. undef) )
     1360       where ( (x(:,:,k) .gt. S_att) .AND. (x(:,:,k) .ne. undef) )
    13611361          srok(:,:,k)=1._wp
    13621362       elsewhere
    … …  
    13641364       endwhere
    13651365       ! Number of usefull sub-columns layers for z_opaque 3D fraction:
    1366        where ( (x(:,:,k) .ge. 0.) .and. (x(:,:,k) .ne. undef) ) !DEBUG
     1366       where ( (x(:,:,k) .ge. 0.) .AND. (x(:,:,k) .ne. undef) ) !DEBUG
    13671367          srokopaq(:,:,k)=1._wp
    13681368       elsewhere
    … …  
    13971397
    13981398     ! Declaring non-opaque cloudy profiles as thin cloud profiles
    1399        if ( cldlay(ip,ic,4).gt. 0. .and. cldlay(ip,ic,1) .eq. 0. ) then
     1399       if ( cldlay(ip,ic,4).gt. 0. .AND. cldlay(ip,ic,1) .eq. 0. ) then
    14001400          cldlay(ip,ic,2)  =  1._wp
    14011401        endif
    … …  
    14101410     ! Declaring z_opaque altitude and opaque cloud fraction for 3D and 2D variables
    14111411     ! From SFC-2-TOA ( actually from vgrid_z(SFC+1) = vgrid_z(Nlevels-1) )
    1412              if ( cldy(ip,ic,Nlevels-k) .eq. 1. .and. zopac .eq. 0. ) then
     1412             if ( cldy(ip,ic,Nlevels-k) .eq. 1. .AND. zopac .eq. 0. ) then
    14131413            lidarcldtype(ip,Nlevels-k + 1,3) = lidarcldtype(ip,Nlevels-k + 1,3) + 1._wp
    14141414            cldlay(ip,ic,3)                  = vgrid_z(Nlevels-k+1)      ! z_opaque altitude
    … …  
    14421442     ! Declaring thin cloud fraction for 3D variable
    14431443     ! From TOA-2-SFC
    1444                  if ( cldy(ip,ic,k) .eq. 1. .and. topcloud .eq. 1. ) then
     1444                 if ( cldy(ip,ic,k) .eq. 1. .AND. topcloud .eq. 1. ) then
    14451445                    lidarcldtype(ip,k,2) = lidarcldtype(ip,k,2) + 1._wp
    14461446            z_base = k ! bottom cloud layer
    14471447                 endif
    1448              if ( cldy(ip,ic,k) .eq. 1. .and. topcloud .eq. 0. ) then
     1448             if ( cldy(ip,ic,k) .eq. 1. .AND. topcloud .eq. 0. ) then
    14491449                    lidarcldtype(ip,k,2) = lidarcldtype(ip,k,2) + 1._wp
    14501450            z_top = k  ! top cloud layer
    … …  
    14581458          cloudemis = 0._wp
    14591459               DO k=z_base+1,Nlevels
    1460              if (  (x(ip,ic,k) .gt. S_att_opaq) .and. (x(ip,ic,k) .lt. 1.0) .and. (x(ip,ic,k) .ne. undef)  ) then
     1460             if (  (x(ip,ic,k) .gt. S_att_opaq) .AND. (x(ip,ic,k) .lt. 1.0) .AND. (x(ip,ic,k) .ne. undef)  ) then
    14611461            srmean = srmean + x(ip,ic,k)
    14621462            srcount = srcount + 1.
    … …  
    15021502    DO ip = 1, Npoints
    15031503         DO k = 2, Nlevels
    1504             if ( (lidarcldtype(ip,k,3) .ne. undef) .and. (lidarcldtype(ip,k-1,4) .ne. undef) ) then
     1504            if ( (lidarcldtype(ip,k,3) .ne. undef) .AND. (lidarcldtype(ip,k-1,4) .ne. undef) ) then
    15051505            lidarcldtype(ip,k,4) = lidarcldtype(ip,k,3) + lidarcldtype(ip,k-1,4)
    15061506        else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_interface.F90

    r5160 r5185  
    311311
    312312!!! Ici on modifie les cles logiques pour les outputs selon les champs actives dans les .xml
    313   if ((itap.ge.1).and.(first_write))then
     313  if ((itap.ge.1).AND.(first_write))then
    314314    IF (using_xios) call read_xiosfieldactive(cfg)
    315315    first_write=.false.
    … …  
    344344    cfg%Lisccp, cfg%Lmisr, cfg%Lmodis, cfg%Lrttov
    345345
    346   endif !(itap.gt.1).and.(first_write)
     346  endif !(itap.gt.1).AND.(first_write)
    347347
    348348  time_bnds(1) = dtime-dtime/2.

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90

    r5158 r5185  
    389389!    do k=1,PARASOL_NREFL
    390390!     do ip=1, Npoints
    391 !      if (stlidar%cldlayer(ip,4).gt.1.and.stlidar%parasolrefl(ip,k).ne.missing_val) then
     391!      if (stlidar%cldlayer(ip,4).gt.1.AND.stlidar%parasolrefl(ip,k).ne.missing_val) then
    392392!        parasolcrefl(ip,k)=(stlidar%parasolrefl(ip,k)-0.03*(1.-stlidar%cldlayer(ip,4)/100.))/ &
    393393!                             (stlidar%cldlayer(ip,4)/100.)
    … …  
    470470
    471471!!! Sorties combinees Cloudsat et Calipso
    472  if (cfg%Lcalipso .and. cfg%Lcloudsat) then
     472 if (cfg%Lcalipso .AND. cfg%Lcloudsat) then
    473473
    474474   if (cfg%Lclcalipso2) then

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/lmdz_cosp_subsample_and_optics_mod.F90

    r5158 r5185  
    361361       DO i=1,nPoints
    362362          DO j=1,nLevels
    363              if (cospIN%rcfg_cloudsat%use_gas_abs == 1 .or. (cospIN%rcfg_cloudsat%use_gas_abs == 2 .and. j .eq. 1)) then
     363             if (cospIN%rcfg_cloudsat%use_gas_abs == 1 .or. (cospIN%rcfg_cloudsat%use_gas_abs == 2 .AND. j .eq. 1)) then
    364364                g_vol(i,j) = gases(cospstateIN%pfull(i,j), cospstateIN%at(i,j),cospstateIN%qv(i,j),cospIN%rcfg_cloudsat%freq)
    365365             endif

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/modis_simulator.F90

    r5158 r5185  
    223223       end if
    224224    end do
    225     where((retrievedSize(1:nSubCols) < 0.).and.(retrievedSize(1:nSubCols) /= R_UNDEF)) &
     225    where((retrievedSize(1:nSubCols) < 0.).AND.(retrievedSize(1:nSubCols) /= R_UNDEF)) &
    226226         retrievedSize(1:nSubCols) = 1.0e-06_wp*re_fill
    227227
    … …  
    229229    ! mimics what MODIS does to first order.
    230230    ! Of course, ISCCP cloud top pressures are in mb.   
    231     where(cloudMask(1:nSubCols) .and. retrievedCloudTopPressure(1:nSubCols) > CO2Slicing_PressureLimit) &
     231    where(cloudMask(1:nSubCols) .AND. retrievedCloudTopPressure(1:nSubCols) > CO2Slicing_PressureLimit) &
    232232         retrievedCloudTopPressure(1:nSubCols) = isccpCloudTopPressure! * 100._wp
    233233   
    … …  
    297297    ! ########################################################################################
    298298    validRetrievalMask(1:nPoints,1:nSubCols) = particle_size(1:nPoints,1:nSubCols) > 0.
    299     cloudMask(1:nPoints,1:nSubCols) = phase(1:nPoints,1:nSubCols) /= phaseIsNone .and.       &
     299    cloudMask(1:nPoints,1:nSubCols) = phase(1:nPoints,1:nSubCols) /= phaseIsNone .AND.       &
    300300         validRetrievalMask(1:nPoints,1:nSubCols)
    301     waterCloudMask(1:nPoints,1:nSubCols) = phase(1:nPoints,1:nSubCols) == phaseIsLiquid .and. &
     301    waterCloudMask(1:nPoints,1:nSubCols) = phase(1:nPoints,1:nSubCols) == phaseIsLiquid .AND. &
    302302         validRetrievalMask(1:nPoints,1:nSubCols)
    303     iceCloudMask(1:nPoints,1:nSubCols)   = phase(1:nPoints,1:nSubCols) == phaseIsIce .and.    &
     303    iceCloudMask(1:nPoints,1:nSubCols)   = phase(1:nPoints,1:nSubCols) == phaseIsIce .AND.    &
    304304         validRetrievalMask(1:nPoints,1:nSubCols)
    305305   
    … …  
    310310    Cloud_Fraction_Water_Mean(1:nPoints) = real(count(waterCloudMask, dim = 2))
    311311    Cloud_Fraction_Ice_Mean(1:nPoints)   = real(count(iceCloudMask,   dim = 2))
    312     Cloud_Fraction_High_Mean(1:nPoints)  = real(count(cloudMask .and. cloud_top_pressure <=          &
     312    Cloud_Fraction_High_Mean(1:nPoints)  = real(count(cloudMask .AND. cloud_top_pressure <=          &
    313313                                           highCloudPressureLimit, dim = 2))
    314     Cloud_Fraction_Low_Mean(1:nPoints)   = real(count(cloudMask .and. cloud_top_pressure >           &
     314    Cloud_Fraction_Low_Mean(1:nPoints)   = real(count(cloudMask .AND. cloud_top_pressure >           &
    315315                                           lowCloudPressureLimit,  dim = 2))
    316316    Cloud_Fraction_Mid_Mean(1:nPoints)   = Cloud_Fraction_Total_Mean(1:nPoints) - Cloud_Fraction_High_Mean(1:nPoints)&

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/parasol.F90

    r5158 r5185  
    118118    DO it=1,PARASOL_NREFL
    119119       DO ny=1,PARASOL_NTAU-1
    120           WHERE (tautot_S(1:npoints) .ge. PARASOL_TAU(ny).and. &
     120          WHERE (tautot_S(1:npoints) .ge. PARASOL_TAU(ny).AND. &
    121121                 tautot_S(1:npoints) .le. PARASOL_TAU(ny+1))
    122122             rlumA_mod(1:npoints,it) = aA(it,ny)*tautot_S(1:npoints) + bA(it,ny)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/prec_scops.F90

    r5158 r5185  
    200200          endif
    201201        enddo ! loop over ncol
    202         if ((flag_ls .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
     202        if ((flag_ls .eq. 0) .AND. (ilev .lt. nlev)) then ! possibility THREE
    203203        DO ibox=1,ncol
    204204        if (frac_out(j,ibox,ilev+1) .eq. 1) then
    … …  
    236236        endif
    237237       enddo ! loop over ncol
    238         if ((flag_cv .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
     238        if ((flag_cv .eq. 0) .AND. (ilev .lt. nlev)) then ! possibility THREE
    239239        DO ibox=1,ncol
    240240        if (frac_out(j,ibox,ilev+1) .eq. 2) then

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/quickbeam.F90

    r5158 r5185  
    179179         
    180180          ! Attenuation due to gaseous absorption between radar and volume
    181           if ((rcfg%use_gas_abs == 1) .or. (rcfg%use_gas_abs == 2 .and. pr .eq. 1)) then
     181          if ((rcfg%use_gas_abs == 1) .or. (rcfg%use_gas_abs == 2 .AND. pr .eq. 1)) then
    182182             if (d_gate==1) then
    183183                if (k>1) then
    … …  
    402402       DO pr=1,Ncolumns
    403403          ! 1) Compute the PIA in all profiles containing hydrometeors
    404           if ( (Ze_non_out(i,pr,cloudsat_preclvl).gt.-100) .and. (Ze_out(i,pr,cloudsat_preclvl).gt.-100) ) then
    405              if ( (Ze_non_out(i,pr,cloudsat_preclvl).lt.100) .and. (Ze_out(i,pr,cloudsat_preclvl).lt.100) ) then
     404          if ( (Ze_non_out(i,pr,cloudsat_preclvl).gt.-100) .AND. (Ze_out(i,pr,cloudsat_preclvl).gt.-100) ) then
     405             if ( (Ze_non_out(i,pr,cloudsat_preclvl).lt.100) .AND. (Ze_out(i,pr,cloudsat_preclvl).lt.100) ) then
    406406                cloudsat_precip_pia(i,pr) = Ze_non_out(i,pr,cloudsat_preclvl) - Ze_out(i,pr,cloudsat_preclvl)
    407407             endif
    … …  
    419419                   cloudsat_pflag(i,pr) = pClass_Snow2                   ! TSL: Snow certain
    420420                endif
    421                 if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(4).and. &
     421                if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(4).AND. &
    422422                     Ze_non_out(i,pr,cloudsat_preclvl).le.Zenonbinval(2)) then
    423423                   cloudsat_pflag(i,pr) = pClass_Snow1                   ! TSL: Snow possible
    … …  
    426426             
    427427             ! Mixed
    428              if(fracPrecipIce(i,pr).gt.0.1.and.fracPrecipIce(i,pr).le.0.9) then
     428             if(fracPrecipIce(i,pr).gt.0.1.AND.fracPrecipIce(i,pr).le.0.9) then
    429429                if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(2)) then
    430430                   cloudsat_pflag(i,pr) = pClass_Mixed2                  ! TSL: Mixed certain
    431431                endif
    432                 if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(4).and. &
     432                if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(4).AND. &
    433433                     Ze_non_out(i,pr,cloudsat_preclvl).le.Zenonbinval(2)) then
    434434                   cloudsat_pflag(i,pr) = pClass_Mixed1                  ! TSL: Mixed possible
    … …  
    441441                   cloudsat_pflag(i,pr) = pClass_Rain3                   ! TSL: Rain certain
    442442                endif
    443                 if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(3).and. &
     443                if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(3).AND. &
    444444                     Ze_non_out(i,pr,cloudsat_preclvl).le.Zenonbinval(1)) then
    445445                   cloudsat_pflag(i,pr) = pClass_Rain2                   ! TSL: Rain probable
    446446                endif
    447                 if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(4).and. &
     447                if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(4).AND. &
    448448                     Ze_non_out(i,pr,cloudsat_preclvl).le.Zenonbinval(3)) then
    449449                   cloudsat_pflag(i,pr) = pClass_Rain1                   ! TSL: Rain possible
    … …  
    472472                   cloudsat_pflag(i,pr) = pClass_Snow2                      ! JEK: Snow certain
    473473                endif
    474                 if(Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(6) .and. &
     474                if(Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(6) .AND. &
    475475                     Ze_out(i,pr,cloudsat_preclvl).le.Zbinvallnd(5)) then
    476476                   cloudsat_pflag(i,pr) = pClass_Snow1                      ! JEK: Snow possible
    … …  
    479479             
    480480             ! Mized phase (273<T<275)
    481              if(t2m(i) .ge. 273._wp .and. t2m(i) .le. 275._wp) then
    482                 if ((Zmax .gt. Zbinvallnd(1) .and. cloudsat_precip_pia(i,pr).gt.30) .or. &
     481             if(t2m(i) .ge. 273._wp .AND. t2m(i) .le. 275._wp) then
     482                if ((Zmax .gt. Zbinvallnd(1) .AND. cloudsat_precip_pia(i,pr).gt.30) .or. &
    483483                     (Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(4))) then
    484484                   cloudsat_pflag(i,pr) = pClass_Mixed2                     ! JEK: Mixed certain
    485485                endif
    486                 if ((Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(6)  .and. &
    487                      Ze_out(i,pr,cloudsat_preclvl) .le. Zbinvallnd(4)) .and. &
     486                if ((Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(6)  .AND. &
     487                     Ze_out(i,pr,cloudsat_preclvl) .le. Zbinvallnd(4)) .AND. &
    488488                     (Zmax .gt. Zbinvallnd(5)) ) then
    489489                   cloudsat_pflag(i,pr) = pClass_Mixed1                     ! JEK: Mixed possible
    … …  
    493493             ! Rain (T>275)
    494494             if(t2m(i) .gt. 275) then
    495                 if ((Zmax .gt. Zbinvallnd(1) .and. cloudsat_precip_pia(i,pr).gt.30) .or. &
     495                if ((Zmax .gt. Zbinvallnd(1) .AND. cloudsat_precip_pia(i,pr).gt.30) .or. &
    496496                     (Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(2))) then
    497497                   cloudsat_pflag(i,pr) = pClass_Rain3                      ! JEK: Rain certain
    498498                endif
    499                 if((Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(6)) .and. &
     499                if((Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(6)) .AND. &
    500500                     (Zmax .gt. Zbinvallnd(3))) then
    501501                   cloudsat_pflag(i,pr) = pClass_Rain2                      ! JEK: Rain probable
    502502                endif
    503                 if((Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(6)) .and. &
     503                if((Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(6)) .AND. &
    504504                     (Zmax.lt.Zbinvallnd(3))) then
    505505                   cloudsat_pflag(i,pr) = pClass_Rain1                      ! JEK: Rain possible
    … …  
    536536 
    537537    ! Normalize by number of subcolumns
    538     where ((cloudsat_precip_cover /= R_UNDEF).and.(cloudsat_precip_cover /= 0.0)) &
     538    where ((cloudsat_precip_cover /= R_UNDEF).AND.(cloudsat_precip_cover /= 0.0)) &
    539539         cloudsat_precip_cover = cloudsat_precip_cover / Ncolumns
    540     where ((cloudsat_pia/= R_UNDEF).and.(cloudsat_pia/= 0.0)) &
     540    where ((cloudsat_pia/= R_UNDEF).AND.(cloudsat_pia/= 0.0)) &
    541541         cloudsat_pia = cloudsat_pia / Ncolumns
    542542

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/quickbeam_optics.F90

    r5158 r5185  
    145145          hydro = .false.
    146146          DO j=1,rcfg%nhclass
    147              if ((hm_matrix(pr,k,j) > 1E-12) .and. (sd%dtype(j) > 0)) then
     147             if ((hm_matrix(pr,k,j) > 1E-12) .AND. (sd%dtype(j) > 0)) then
    148148                hydro = .true.
    149149                exit
    … …  
    217217                ! Use Ze_scaled, Zr_scaled, and kr_scaled ... if know them
    218218                ! if not we will calculate Ze, Zr, and Kr from the distribution parameters
    219 !                if( rcfg%Z_scale_flag(tp,itt,iRe_type) .and. .not. DO_LUT_TEST)  then
     219!                if( rcfg%Z_scale_flag(tp,itt,iRe_type) .AND. .not. DO_LUT_TEST)  then
    220220!                   ! can use z scaling
    221221!                   scale_factor=rho_a*hm_matrix(pr,k,tp)
    … …  
    272272                   else
    273273                      ! I assume here that water phase droplets are spheres.
    274                       ! sd%rho should be ~ 1000  or sd%apm=524 .and. sd%bpm=3
     274                      ! sd%rho should be ~ 1000  or sd%apm=524 .AND. sd%bpm=3
    275275                      Deq = Di
    276276                   endif
    … …  
    292292                   ! NOTE: if .not. DO_LUT_TEST, then you are checking the LUT approximation
    293293                   ! not just the DSD representation given by Ni
    294                    if(Np_matrix(pr,k,tp)>0 .and. DO_NP_TEST ) then
     294                   if(Np_matrix(pr,k,tp)>0 .AND. DO_NP_TEST ) then
    295295                      Np = path_integral(Ni,Di,1,ns-1)/rho_a*1.E6_wp
    296296                      ! Note: Representation is not great or small Re < 2
    … …  
    305305                   ! LUT test code
    306306                   ! This segment of code compares full calculation to scaling result
    307                    if ( rcfg%Z_scale_flag(tp,itt,iRe_type) .and. DO_LUT_TEST )  then
     307                   if ( rcfg%Z_scale_flag(tp,itt,iRe_type) .AND. DO_LUT_TEST )  then
    308308                      scale_factor=rho_a*hm_matrix(pr,k,tp)
    309309                      ! if more than 2 dBZe difference print error message/parameters.
    … …  
    398398   
    399399    ! If density is constant, set equivalent values for apm and bpm
    400     if ((rho_c > 0) .and. (apm < 0)) then
     400    if ((rho_c > 0) .AND. (apm < 0)) then
    401401       apm = (pi/6)*rho_c
    402402       bpm = 3._wp
    … …  
    405405    ! Exponential is same as modified gamma with vu =1
    406406    ! if Np is specified then we will just treat as modified gamma
    407     if(dtype .eq. 2 .and. Np .gt. 0) then
     407    if(dtype .eq. 2 .AND. Np .gt. 0) then
    408408       local_dtype = 1
    409409       local_p3    = 1
    … …  
    441441       endif
    442442       
    443        if( Np.eq.0 .and. p2+1 > 1E-8) then     ! use default value for MEAN diameter as first default 
     443       if( Np.eq.0 .AND. p2+1 > 1E-8) then     ! use default value for MEAN diameter as first default
    444444          dm = p2             ! by definition, should have units of microns
    445445          D0 = gamma(vu)/gamma(vu+1)*dm
    … …  
    525525       
    526526       ! get rg ...
    527        if( Np.eq.0 .and. (abs(p2+1) > 1E-8) ) then ! use default value of rg
     527       if( Np.eq.0 .AND. (abs(p2+1) > 1E-8) ) then ! use default value of rg
    528528          rg = p2     
    529529       else
    … …  
    640640   
    641641    ! If density is constant, store equivalent values for apm and bpm
    642     if ((rho_c > 0) .and. (apm < 0)) then
     642    if ((rho_c > 0) .AND. (apm < 0)) then
    643643       apm = (pi/6)*rho_c
    644644       bpm = 3._wp
    … …  
    648648    ! if only Np given then calculate Re
    649649    ! if neigher than use other defaults (p1,p2,p3) following quickbeam documentation
    650     if(Re==0 .and. Np>0) then
     650    if(Re==0 .AND. Np>0) then
    651651       call calc_Re(Q,Np,rho_a,dtype,apm,bpm,rho_c,p1,p2,p3,Re)
    652652    endif
    … …  
    754754          if (tc < -30) then
    755755             bhp = -1.75_wp+0.09_wp*((tc+273._wp)-243.16_wp)
    756           elseif ((tc >= -30) .and. (tc < -9)) then
     756          elseif ((tc >= -30) .AND. (tc < -9)) then
    757757             bhp = -3.25_wp-0.06_wp*((tc+273._wp)-265.66_wp)
    758758          else
    … …  
    764764          if (tc < -35) then
    765765             bhp = -1.75_wp+0.09_wp*((tc+273._wp)-243.16_wp)
    766           elseif ((tc >= -35) .and. (tc < -17.5)) then
     766          elseif ((tc >= -35) .AND. (tc < -17.5)) then
    767767             bhp = -2.65_wp+0.09_wp*((tc+273._wp)-255.66_wp)
    768           elseif ((tc >= -17.5) .and. (tc < -9)) then
     768          elseif ((tc >= -17.5) .AND. (tc < -9)) then
    769769             bhp = -3.25_wp-0.06_wp*((tc+273._wp)-265.66_wp)
    770770          else
    … …  
    969969       
    970970       correct_for_rho = 0
    971        if ((ice == 1) .and. (minval(rho_e) >= 0)) correct_for_rho = 1
     971       if ((ice == 1) .AND. (minval(rho_e) >= 0)) correct_for_rho = 1
    972972       
    973973       ! Correct refractive index for ice density if needed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/scops.F90

    r5158 r5185  
    7575
    7676    ! Test for valid input overlap assumption
    77     if (overlap .ne. 1 .and. overlap .ne. 2 .and. overlap .ne. 3) then
     77    if (overlap .ne. 1 .AND. overlap .ne. 2 .AND. overlap .ne. 3) then
    7878       overlap=default_overlap
    7979       call errorMessage('ERROR(scops): Invalid overlap assumption provided. Using default overlap assumption (max/ran)')
    … …  
    180180             !threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)))
    181181             !maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) .lt. &
    182              !     min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)) .and. &
     182             !     min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)) .AND. &
    183183             !     (threshold(1:npoints,ibox).gt.conv(1:npoints,ilev)))
    184184             if (ilev .ne. 1) then
    185185                threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)))
    186186                maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) .lt. &
    187                      min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)) .and. &
     187                     min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)) .AND. &
    188188                     (threshold(1:npoints,ibox).gt.conv(1:npoints,ilev)))
    189189             else
    190190                threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(0._wp,tca(1:npoints,ilev)))
    191191                maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) .lt. &
    192                      min(0._wp,tca(1:npoints,ilev)) .and. &
     192                     min(0._wp,tca(1:npoints,ilev)) .AND. &
    193193                     (threshold(1:npoints,ibox).gt.conv(1:npoints,ilev)))
    194194             endif
    … …  
    208208         
    209209          ! Code to partition boxes into startiform and convective parts goes here
    210           where(threshold(1:npoints,ibox).le.conv(1:npoints,ilev) .and. conv(1:npoints,ilev).gt.0.) frac_out(1:npoints,ibox,ilev)=2
     210          where(threshold(1:npoints,ibox).le.conv(1:npoints,ilev) .AND. conv(1:npoints,ilev).gt.0.) frac_out(1:npoints,ibox,ilev)=2
    211211       ENDDO ! ibox
    212212       

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_infotrac.f90

    r5184 r5185  
    1 link ../../dyn3d_common/infotrac.F90
     1link ../../dyn3d_common/lmdz_infotrac.f90

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/abor1.F90

    r5159 r5185  
    2323  ! FLUSH not understood by NAG compiler
    2424  !CALL FLUSH(NULOUT)
    25   IF (NULOUT /= 0 .and. NULOUT /= 6) CLOSE(NULOUT)
     25  IF (NULOUT /= 0 .AND. NULOUT /= 6) CLOSE(NULOUT)
    2626ENDIF
    2727

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/easy_netcdf.F90

    r5159 r5185  
    763763    DO j = 1, ndims
    764764      n = n * ndimlens(j)
    765       if (j > 1 .and. ndimlens(j) > 1) then
     765      if (j > 1 .AND. ndimlens(j) > 1) then
    766766        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
    767767             & var_name, &
    … …  
    821821    DO j = 1, ndims
    822822      n = n * ndimlens(j)
    823       if (j > 1 .and. ndimlens(j) > 1) then
     823      if (j > 1 .AND. ndimlens(j) > 1) then
    824824        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
    825825             & var_name, &
    … …  
    880880    DO j = 1, ndims
    881881      n = n * ndimlens(j)
    882       if (j > 1 .and. ndimlens(j) > 1) then
     882      if (j > 1 .AND. ndimlens(j) > 1) then
    883883        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
    884884             & var_name, &
    … …  
    940940    DO j = 1, ndims-1
    941941      n = n * ndimlens(j)
    942       if (j > 1 .and. ndimlens(j) > 1) then
     942      if (j > 1 .AND. ndimlens(j) > 1) then
    943943        write(nulerr,'(a,a,a)') '*** Error reading 1D slice from NetCDF variable ', &
    944944             & var_name, &
    … …  
    10231023    DO j = 1, ndims
    10241024      ntotal = ntotal * ndimlens(j)
    1025       if (j > 2 .and. ndimlens(j) > 1) then
     1025      if (j > 2 .AND. ndimlens(j) > 1) then
    10261026        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
    10271027           & var_name, &
    … …  
    11351135    DO j = 1, ndims
    11361136      ntotal = ntotal * ndimlens(j)
    1137       if (j > 2 .and. ndimlens(j) > 1) then
     1137      if (j > 2 .AND. ndimlens(j) > 1) then
    11381138        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
    11391139           & var_name, &
    … …  
    12541254    DO j = 1, ndims-1
    12551255      ntotal = ntotal * ndimlens(j)
    1256       if (j > 2 .and. ndimlens(j) > 1) then
     1256      if (j > 2 .AND. ndimlens(j) > 1) then
    12571257        write(nulerr,'(a,a,a)') '*** Error reading 2D slice from NetCDF variable ', &
    12581258           & var_name, &
    … …  
    13781378    DO j = 1, ndims
    13791379      ntotal = ntotal * ndimlens(j)
    1380       if (j > 3 .and. ndimlens(j) > 1) then
     1380      if (j > 3 .AND. ndimlens(j) > 1) then
    13811381        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
    13821382           & var_name, &
    … …  
    15141514    DO j = 1, ndims-1
    15151515      ntotal = ntotal * ndimlens(j)
    1516       if (j > 3 .and. ndimlens(j) > 1) then
     1516      if (j > 3 .AND. ndimlens(j) > 1) then
    15171517        write(nulerr,'(a,a,a)') '*** Error reading 3D slice from NetCDF variable ', &
    15181518           & var_name, &
    … …  
    16561656    DO j = 1, ndims
    16571657      ntotal = ntotal * ndimlens(j)
    1658       if (j > 4 .and. ndimlens(j) > 1) then
     1658      if (j > 4 .AND. ndimlens(j) > 1) then
    16591659        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
    16601660           & var_name, &
    … …  
    19871987    end if
    19881988
    1989     if (present(dim1_name) .and. ndims_input >= 1) then
     1989    if (present(dim1_name) .AND. ndims_input >= 1) then
    19901990      ! Variable is at least one dimensional
    19911991      ndims_local = 1
    … …  
    19961996        call my_abort('Error writing NetCDF file')
    19971997      end if
    1998       if (present(dim2_name) .and. ndims_input >= 2) then
     1998      if (present(dim2_name) .AND. ndims_input >= 2) then
    19991999        ! Variable is at least two dimensional
    20002000        ndims_local = 2
    … …  
    20052005          call my_abort('Error writing NetCDF file')
    20062006        end if
    2007         if (present(dim3_name) .and. ndims_input >= 3) then
     2007        if (present(dim3_name) .AND. ndims_input >= 3) then
    20082008          ! Variable is at least three dimensional
    20092009          ndims_local = 3
    … …  
    20142014            call my_abort('Error writing NetCDF file')
    20152015          end if
    2016           if (present(dim4_name) .and. ndims_input >= 4) then
     2016          if (present(dim4_name) .AND. ndims_input >= 4) then
    20172017            ! Variable is at least three dimensional
    20182018            ndims_local = 4
    … …  
    24722472    ! Check the total size of the variable to be stored (but receiving
    24732473    ! ntotal is zero then there must be an unlimited dimension)
    2474     if (ntotal /= size(var,kind=jpib) .and. ntotal /= 0) then
     2474    if (ntotal /= size(var,kind=jpib) .AND. ntotal /= 0) then
    24752475      write(nulerr,'(a,i0,a,a,a,i0)') '*** Error: attempt to write matrix of total size ', &
    24762476           & nvarlen, ' to ', var_name, ' which has total size ', ntotal
    … …  
    25512551      write(var_slice_name,'(a,a,i0,a)') var_name, '(:,:,', index3, ')'
    25522552    end if
    2553     if (ntotal /= size(var,kind=jpib) .and. ntotal /= 0) then
     2553    if (ntotal /= size(var,kind=jpib) .AND. ntotal /= 0) then
    25542554      write(nulerr,'(a,i0,a,a,a,i0)') '*** Error: attempt to write matrix of total size ', &
    25552555           & nvarlen, ' to ', trim(var_slice_name), ' which has total size ', ntotal

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_aerosol_optics.F90

    r5159 r5185  
    290290        else
    291291          iwn = 1
    292           DO while (wavenumber(iwn+1) < wavenumber_target .and. iwn < nwn-1)
     292          DO while (wavenumber(iwn+1) < wavenumber_target .AND. iwn < nwn-1)
    293293            iwn = iwn + 1
    294294          end do
    … …  
    703703            iband = config%i_band_from_reordered_g_sw(jg)
    704704            local_od = od_sw(jg,jlev,jcol) + od_sw_aerosol(iband)
    705             if (local_od > 0.0_jprb .and. od_sw_aerosol(iband) > 0.0_jprb) then
     705            if (local_od > 0.0_jprb .AND. od_sw_aerosol(iband) > 0.0_jprb) then
    706706              local_scat = ssa_sw(jg,jlev,jcol) * od_sw(jg,jlev,jcol) &
    707707                   &  + scat_sw_aerosol(iband)
    … …  
    728728              iband = config%i_band_from_reordered_g_lw(jg)
    729729              local_od = od_lw(jg,jlev,jcol) + od_lw_aerosol(iband)
    730               if (local_od > 0.0_jprb .and. od_lw_aerosol(iband) > 0.0_jprb) then
     730              if (local_od > 0.0_jprb .AND. od_lw_aerosol(iband) > 0.0_jprb) then
    731731                ! All scattering is due to aerosols, therefore the
    732732                ! asymmetry factor is equal to the value for aerosols

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_aerosol_optics_data.F90

    r5159 r5185  
    373373    end if
    374374
    375     if (n_type_philic > 0 .and. nrh > 0) then
     375    if (n_type_philic > 0 .AND. nrh > 0) then
    376376      if (n_bands_sw > 0) then
    377377        allocate(this%mass_ext_sw_philic(n_bands_sw, nrh, n_type_philic))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_aerosol_optics_description.F90

    r5159 r5185  
    140140      ! Check if we have a match
    141141      if (to_string(this%code_philic(:,ja)) == code_str &
    142            &  .and. to_string(this%optical_model_philic(1:len(optical_model_str),ja)) &
     142           &  .AND. to_string(this%optical_model_philic(1:len(optical_model_str),ja)) &
    143143           &          == optical_model_str) then
    144144        this%is_preferred_philic(ja) = .true.
    … …  
    148148    DO ja = 1,size(this%bin_phobic)
    149149      if (to_string(this%code_phobic(:,ja)) == code_str &
    150            &  .and. to_string(this%optical_model_phobic(1:len(optical_model_str),ja)) &
     150           &  .AND. to_string(this%optical_model_phobic(1:len(optical_model_str),ja)) &
    151151           &          == optical_model_str) then
    152152        this%is_preferred_phobic(ja) = .true.
    … …  
    211211        if (to_string(this%code_philic(:,ja)) == code_str) then
    212212          ! Aerosol code matches
    213           if (present(ibin) .and. this%bin_philic(ja) > 0) then
     213          if (present(ibin) .AND. this%bin_philic(ja) > 0) then
    214214            if (ibin > 0) then
    215215              if (ibin == this%bin_philic(ja)) then
    … …  
    243243            current_score = current_score + 2
    244244          end if
    245           if (current_score > 0 .and. this%is_preferred_philic(ja)) then
     245          if (current_score > 0 .AND. this%is_preferred_philic(ja)) then
    246246            current_score = current_score + 1
    247247          end if
    … …  
    251251            score = current_score
    252252            is_ambiguous = .false.
    253           else if (current_score > 0 .and. current_score == score) then
     253          else if (current_score > 0 .AND. current_score == score) then
    254254            is_ambiguous = .true.
    255255          end if
    … …  
    262262        if (to_string(this%code_phobic(:,ja)) == code_str) then
    263263          ! Aerosol code matches
    264           if (present(ibin) .and. this%bin_phobic(ja) > 0) then
     264          if (present(ibin) .AND. this%bin_phobic(ja) > 0) then
    265265            if (ibin > 0) then
    266266              if (ibin == this%bin_phobic(ja)) then
    … …  
    294294            current_score = current_score + 2
    295295          end if
    296           if (current_score > 0 .and. this%is_preferred_phobic(ja)) then
     296          if (current_score > 0 .AND. this%is_preferred_phobic(ja)) then
    297297            current_score = current_score + 1
    298298          end if
    … …  
    302302            score = current_score
    303303            is_ambiguous = .false.
    304           else if (current_score > 0 .and. current_score == score) then
     304          else if (current_score > 0 .AND. current_score == score) then
    305305            is_ambiguous = .true.
    306306          end if         

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_check.F90

    r5159 r5185  
    4848    if (allocated(var)) then
    4949
    50       if (present(i1) .and. present(i2)) then
     50      if (present(i1) .AND. present(i2)) then
    5151        varmin = minval(var(i1:i2))
    5252        varmax = maxval(var(i1:i2))
    … …  
    6262        is_bad = .true.
    6363        if (do_fix) then
    64           if (present(i1) .and. present(i2)) then
     64          if (present(i1) .AND. present(i2)) then
    6565            var(i1:i2) = max(boundmin, min(boundmax, var(i1:i2)))
    6666          else
    … …  
    105105    if (allocated(var)) then
    106106
    107       if (present(i1) .and. present(i2)) then
     107      if (present(i1) .AND. present(i2)) then
    108108        ii1 = i1
    109109        ii2 = i2
    … …  
    112112        ii2 = ubound(var,1)
    113113      end if
    114       if (present(j1) .and. present(j2)) then
     114      if (present(j1) .AND. present(j2)) then
    115115        jj1 = j1
    116116        jj2 = j2
    … …  
    168168    if (allocated(var)) then
    169169
    170       if (present(i1) .and. present(i2)) then
     170      if (present(i1) .AND. present(i2)) then
    171171        ii1 = i1
    172172        ii2 = i2
    … …  
    175175        ii2 = ubound(var,1)
    176176      end if
    177       if (present(j1) .and. present(j2)) then
     177      if (present(j1) .AND. present(j2)) then
    178178        jj1 = j1
    179179        jj2 = j2
    … …  
    182182        jj2 = ubound(var,2)
    183183      end if
    184       if (present(k1) .and. present(k2)) then
     184      if (present(k1) .AND. present(k2)) then
    185185        kk1 = k1
    186186        kk2 = k2

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloud_generator.F90

    r5159 r5185  
    213213          trigger = rand_top(jg) * total_cloud_cover
    214214          jlev = ibegin
    215           DO while (trigger > cum_cloud_cover(jlev) .and. jlev < iend)
     215          DO while (trigger > cum_cloud_cover(jlev) .AND. jlev < iend)
    216216            jlev = jlev + 1
    217217          end do
    … …  
    689689
    690690          ! For each spectral interval, has the first cloud appeared at this level?
    691           first_cloud(jg) = (trigger(jg) <= cum_cloud_cover(jlev) .and. .not. found_cloud(jg))
     691          first_cloud(jg) = (trigger(jg) <= cum_cloud_cover(jlev) .AND. .not. found_cloud(jg))
    692692
    693693          ! ...if so, add to found_cloud
    … …  
    699699          ! prev_cloud)
    700700          is_cloud(jg) = first_cloud(jg) &
    701                &  .or. found_cloud(jg) .and. merge(rand_cloud(jg,jlev)*frac(jlev-1) &
     701               &  .or. found_cloud(jg) .AND. merge(rand_cloud(jg,jlev)*frac(jlev-1) &
    702702               &               < frac(jlev)+frac(jlev-1)-pair_cloud_cover(jlev-1), &
    703703               &             rand_cloud(jg,jlev)*(cum_cloud_cover(jlev-1) - frac(jlev-1)) &
    … …  
    712712          rand_inhom(jg,jlev) = merge(merge(rand_inhom(jg,jlev-1), rand_inhom(jg,jlev), &
    713713               &                           rand_inhom2(jg,jlev) < overlap_param_inhom(jlev-1) &
    714                &                           .and. prev_cloud(jg)), &
     714               &                           .AND. prev_cloud(jg)), &
    715715               &                     0.0_jprb, is_cloud(jg))
    716716        end do

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_cloud_optics.F90

    r5159 r5185  
    138138      end if
    139139    else if (config%i_ice_model == IIceModelBaran &
    140          &  .and. size(config%cloud_optics%ice_coeff_lw, 2) &
     140         &  .AND. size(config%cloud_optics%ice_coeff_lw, 2) &
    141141         &  /= NIceOpticsCoeffsBaran) then
    142142      write(nulerr,'(a,i0,a,i0,a,i0,a)') &
    … …  
    146146      call radiation_abort()
    147147    else if (config%i_ice_model == IIceModelBaran2016 &
    148          &  .and. size(config%cloud_optics%ice_coeff_lw, 2) &
     148         &  .AND. size(config%cloud_optics%ice_coeff_lw, 2) &
    149149         &  /= NIceOpticsCoeffsBaran2016) then
    150150      write(nulerr,'(a,i0,a,i0,a,i0,a)') &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_config.F90

    r5159 r5185  
    809809    do_weighted_surface_mapping   = this%do_weighted_surface_mapping
    810810
    811     if (present(file_name) .and. present(unit)) then
     811    if (present(file_name) .AND. present(unit)) then
    812812      write(nulerr,'(a)') '*** Error: cannot specify both file_name and unit in call to config_type%read'
    813813      call radiation_abort('Radiation configuration error')
    814     else if (.not. present(file_name) .and. .not. present(unit)) then
     814    else if (.not. present(file_name) .AND. .not. present(unit)) then
    815815      write(nulerr,'(a)') '*** Error: neither file_name nor unit specified in call to config_type%read'
    816816      call radiation_abort('Radiation configuration error')
    … …  
    10071007
    10081008    ! Will clouds be used at all?
    1009     if ((this%do_sw .and. this%i_solver_sw /= ISolverCloudless) &
    1010          &  .or. (this%do_lw .and. this%i_solver_lw /= ISolverCloudless)) then
     1009    if ((this%do_sw .AND. this%i_solver_sw /= ISolverCloudless) &
     1010         &  .or. (this%do_lw .AND. this%i_solver_lw /= ISolverCloudless)) then
    10111011      this%do_clouds = .true.
    10121012    else
    … …  
    10151015
    10161016    if (this%i_gas_model == IGasModelIFSRRTMG &
    1017          & .and. (this%use_general_cloud_optics &
     1017         & .AND. (this%use_general_cloud_optics &
    10181018         &        .or. this%use_general_aerosol_optics)) then
    1019       if (this%do_sw .and. this%do_cloud_aerosol_per_sw_g_point) then
     1019      if (this%do_sw .AND. this%do_cloud_aerosol_per_sw_g_point) then
    10201020        write(nulout,'(a)') 'Warning: RRTMG SW only supports cloud/aerosol/surface optical properties per band, not per g-point'
    10211021        this%do_cloud_aerosol_per_sw_g_point = .false.
    10221022      end if
    1023       if (this%do_lw .and. this%do_cloud_aerosol_per_lw_g_point) then
     1023      if (this%do_lw .AND. this%do_cloud_aerosol_per_lw_g_point) then
    10241024        write(nulout,'(a)') 'Warning: RRTMG LW only supports cloud/aerosol/surface optical properties per band, not per g-point'
    10251025        this%do_cloud_aerosol_per_lw_g_point = .false.
    … …  
    10551055
    10561056    ! Check consistency of models
    1057     if (this%do_canopy_fluxes_sw .and. .not. this%do_surface_sw_spectral_flux) then
     1057    if (this%do_canopy_fluxes_sw .AND. .not. this%do_surface_sw_spectral_flux) then
    10581058      if (this%iverbosesetup >= 1) then
    10591059        write(nulout,'(a)') 'Warning: turning on do_surface_sw_spectral_flux as required by do_canopy_fluxes_sw'
    … …  
    10631063
    10641064    ! Will clouds be used at all?
    1065     if ((this%do_sw .and. this%i_solver_sw /= ISolverCloudless) &
    1066          &  .or. (this%do_lw .and. this%i_solver_lw /= ISolverCloudless)) then
     1065    if ((this%do_sw .AND. this%i_solver_sw /= ISolverCloudless) &
     1066         &  .or. (this%do_lw .AND. this%i_solver_lw /= ISolverCloudless)) then
    10671067      this%do_clouds = .true.
    10681068    else
    … …  
    10751075         & .or. this%i_solver_sw == ISolverTripleclouds &
    10761076         & .or. this%i_solver_lw == ISolverTripleclouds) &
    1077          & .and. this%i_overlap_scheme /= IOverlapExponentialRandom) then
     1077         & .AND. this%i_overlap_scheme /= IOverlapExponentialRandom) then
    10781078      write(nulerr,'(a)') '*** Error: SPARTACUS/Tripleclouds solvers can only do Exponential-Random overlap'
    10791079      call radiation_abort('Radiation configuration error')
    10801080    end if
    10811081
    1082     if (jprb < jprd .and. this%iverbosesetup >= 1 &
    1083          &  .and. (this%i_solver_sw == ISolverSPARTACUS &
     1082    if (jprb < jprd .AND. this%iverbosesetup >= 1 &
     1083         &  .AND. (this%i_solver_sw == ISolverSPARTACUS &
    10841084         &    .or. this%i_solver_lw == ISolverSPARTACUS)) then
    10851085      write(nulout,'(a)') 'Warning: the SPARTACUS solver may be unstable in single precision'
    … …  
    12131213    end if
    12141214
    1215     if (this%use_aerosols .and. this%n_aerosol_types == 0) then
     1215    if (this%use_aerosols .AND. this%n_aerosol_types == 0) then
    12161216      if (this%iverbosesetup >= 2) then
    12171217        write(nulout, '(a)') 'Aerosols on but n_aerosol_types=0: optical properties to be computed outside ecRad'
    … …  
    12321232    end if
    12331233
    1234     if (this%i_solver_sw == ISolverSPARTACUS .and. this%do_sw_delta_scaling_with_gases) then
     1234    if (this%i_solver_sw == ISolverSPARTACUS .AND. this%do_sw_delta_scaling_with_gases) then
    12351235      write(nulerr,'(a)') '*** Error: SW delta-Eddington scaling with gases not possible with SPARTACUS solver'
    12361236      call radiation_abort('Radiation configuration error')
    12371237    end if
    12381238
    1239     if ((this%do_lw .and. this%do_sw) .and. &
     1239    if ((this%do_lw .AND. this%do_sw) .AND. &
    12401240         & (     (      this%i_solver_sw == ISolverHomogeneous  &
    1241          &        .and. this%i_solver_lw /= ISolverHomogeneous) &
     1241         &        .AND. this%i_solver_lw /= ISolverHomogeneous) &
    12421242         &  .or. (      this%i_solver_sw /= ISolverHomogeneous  &
    1243          &        .and. this%i_solver_lw == ISolverHomogeneous) &
     1243         &        .AND. this%i_solver_lw == ISolverHomogeneous) &
    12441244         & ) ) then
    12451245      write(nulerr,'(a)') '*** Error: if one solver is "Homogeneous" then the other must be'
    … …  
    12491249    ! Set is_homogeneous if the active solvers are homogeneous, since
    12501250    ! this affects how "in-cloud" water contents are computed
    1251     if (        (this%do_sw .and. this%i_solver_sw == ISolverHomogeneous) &
    1252          & .or. (this%do_lw .and. this%i_solver_lw == ISolverHomogeneous)) then
     1251    if (        (this%do_sw .AND. this%i_solver_sw == ISolverHomogeneous) &
     1252         & .or. (this%do_lw .AND. this%i_solver_lw == ISolverHomogeneous)) then
    12531253      this%is_homogeneous = .true.
    12541254    end if
    … …  
    15681568           &  wavelength1, ' to ', wavelength2, ' m is outside shortwave band'
    15691569      call radiation_abort('Radiation configuration error')
    1570     else if (this%iverbosesetup >= 2 .and. present(weighting_name)) then
     1570    else if (this%iverbosesetup >= 2 .AND. present(weighting_name)) then
    15711571      write(nulout,'(a,a,a,f6.0,a,f6.0,a)') 'Spectral weights for ', &
    15721572           &  weighting_name, ' (', wavenumber1, ' to ', &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ecckd.F90

    r5159 r5185  
    441441
    442442      ! Rayleigh scattering
    443       if (this%is_sw .and. present(rayleigh_od_fl)) then
     443      if (this%is_sw .AND. present(rayleigh_od_fl)) then
    444444        DO jlev = 1,nlev
    445445          rayleigh_od_fl(:,jlev,jcol) = global_multiplier &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_flux.F90

    r5159 r5185  
    361361    if (lhook) call dr_hook('radiation_flux:calc_surface_spectral',0,hook_handle)
    362362
    363     if (config%do_sw .and. config%do_surface_sw_spectral_flux) then
     363    if (config%do_sw .AND. config%do_surface_sw_spectral_flux) then
    364364
    365365      if (use_indexed_sum_vec) then
    … …  
    420420
    421421    ! Fluxes in bands required for canopy radiative transfer
    422     if (config%do_sw .and. config%do_canopy_fluxes_sw) then
     422    if (config%do_sw .AND. config%do_canopy_fluxes_sw) then
    423423      if (config%use_canopy_full_spectrum_sw) then
    424424        this%sw_dn_diffuse_surf_canopy(:,istartcol:iendcol) = this%sw_dn_diffuse_surf_g(:,istartcol:iendcol)
    … …  
    472472    end if ! do_canopy_fluxes_sw
    473473
    474     if (config%do_lw .and. config%do_canopy_fluxes_lw) then
     474    if (config%do_lw .AND. config%do_canopy_fluxes_lw) then
    475475      if (config%use_canopy_full_spectrum_lw) then
    476476        this%lw_dn_surf_canopy(:,istartcol:iendcol) = this%lw_dn_surf_g(:,istartcol:iendcol)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_gas.F90

    r5159 r5185  
    379379      if (this%is_present(igas)) then
    380380        if (iunits == IMassMixingRatio &
    381              &   .and. this%iunits(igas) == IVolumeMixingRatio) then
     381             &   .AND. this%iunits(igas) == IVolumeMixingRatio) then
    382382          sf = sf * GasMolarMass(igas) / AirMolarMass
    383383        else if (iunits == IVolumeMixingRatio &
    384              &   .and. this%iunits(igas) == IMassMixingRatio) then
     384             &   .AND. this%iunits(igas) == IMassMixingRatio) then
    385385          sf = sf * AirMolarMass / GasMolarMass(igas)
    386386        end if
    … …  
    506506    else
    507507      if (iunits == IMassMixingRatio &
    508            &   .and. this%iunits(igas) == IVolumeMixingRatio) then
     508           &   .AND. this%iunits(igas) == IVolumeMixingRatio) then
    509509        sf = sf * GasMolarMass(igas) / AirMolarMass
    510510      else if (iunits == IVolumeMixingRatio &
    511            &   .and. this%iunits(igas) == IMassMixingRatio) then
     511           &   .AND. this%iunits(igas) == IMassMixingRatio) then
    512512        sf = sf * AirMolarMass / GasMolarMass(igas)
    513513      end if

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_homogeneous_lw.F90

    r5159 r5185  
    221221                       &     / od_total
    222222                end where
    223                 where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
     223                where (ssa_total > 0.0_jprb .AND. od_total > 0.0_jprb)
    224224                  g_total = (g(:,jlev,jcol)*ssa(:,jlev,jcol)*od(:,jlev,jcol) &
    225225                       &     +   g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
    … …  
    233233                       &     * od_cloud_g / od_total
    234234                end where
    235                 where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
     235                where (ssa_total > 0.0_jprb .AND. od_total > 0.0_jprb)
    236236                  g_total = g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
    237237                       &     * ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_homogeneous_sw.F90

    r5159 r5185  
    244244                     &     / od_total
    245245              end where
    246               where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
     246              where (ssa_total > 0.0_jprb .AND. od_total > 0.0_jprb)
    247247                g_total = (g(:,jlev,jcol)*ssa(:,jlev,jcol)*od(:,jlev,jcol) &
    248248                     &     +   g_cloud(config%i_band_from_reordered_g_sw,jlev,jcol) &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ifs_rrtm.F90

    r5159 r5185  
    639639      DO jcol = istartcol,iendcol
    640640        temperature = thermodynamics%temperature_hl(jcol,jlev+ilevoffset)
    641         if (temperature < 339.0_jprb .and. temperature >= 160.0_jprb) then
     641        if (temperature < 339.0_jprb .AND. temperature >= 160.0_jprb) then
    642642          ! Linear interpolation between -113 and 66 degC
    643643          ind(jcol)  = int(temperature - 159.0_jprb)
    … …  
    765765    DO jcol = istartcol,iendcol
    766766      Tsurf = temperature(jcol)
    767       if (Tsurf < 339.0_jprb .and. Tsurf >= 160.0_jprb) then
     767      if (Tsurf < 339.0_jprb .AND. Tsurf >= 160.0_jprb) then
    768768        ! Linear interpolation between -113 and 66 degC
    769769        ind(jcol)  = int(Tsurf - 159.0_jprb)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_ifs_rrtm.F90.or

    r3908 r5185  
    626626      do jcol = istartcol,iendcol
    627627        temperature = thermodynamics%temperature_hl(jcol,jlev+ilevoffset)
    628         if (temperature < 339.0_jprb .and. temperature >= 160.0_jprb) then
     628        if (temperature < 339.0_jprb .AND. temperature >= 160.0_jprb) then
    629629          ! Linear interpolation between -113 and 66 degC
    630630          ind(jcol)  = int(temperature - 159.0_jprb)
    … …  
    749749    do jcol = istartcol,iendcol
    750750      Tsurf = temperature(jcol)
    751       if (Tsurf < 339.0_jprb .and. Tsurf >= 160.0_jprb) then
     751      if (Tsurf < 339.0_jprb .AND. Tsurf >= 160.0_jprb) then
    752752        ! Linear interpolation between -113 and 66 degC
    753753        ind(jcol)  = int(Tsurf - 159.0_jprb)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_interface.F90

    r5159 r5185  
    100100    ! solver_lw as they will be needed.
    101101    if (config%do_lw_cloud_scattering &
    102          &  .and. config%i_solver_lw == ISolverMcICA) then
     102         &  .AND. config%i_solver_lw == ISolverMcICA) then
    103103      config%n_g_lw_if_scattering = config%n_g_lw
    104104    end if
    … …  
    381381      ! a NetCDF file
    382382      if (config%do_save_radiative_properties) then
    383         if (istartcol == 1 .and. iendcol == ncol) then
     383        if (istartcol == 1 .AND. iendcol == ncol) then
    384384          rad_prop_file_name = rad_prop_base_file_name // ".nc"
    385385        else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_save.F90

    r5159 r5185  
    8686
    8787    if (config%i_gas_model == IGasModelMonochromatic &
    88          .and. config%mono_lw_wavelength > 0.0_jprb) then
     88         .AND. config%mono_lw_wavelength > 0.0_jprb) then
    8989      lw_units_str = 'W m-3'
    9090    else
    … …  
    126126    end if
    127127
    128     if (config%do_lw .and. config%do_canopy_fluxes_lw) then
     128    if (config%do_lw .AND. config%do_canopy_fluxes_lw) then
    129129      call out_file%define_dimension("canopy_band_lw", &
    130130           &  size(flux%lw_dn_surf_canopy, 1))
    131131    end if
    132     if (config%do_sw .and. config%do_canopy_fluxes_sw) then
     132    if (config%do_sw .AND. config%do_canopy_fluxes_sw) then
    133133      call out_file%define_dimension("canopy_band_sw", &
    134134           &  size(flux%sw_dn_diffuse_surf_canopy, 1))
    … …  
    302302    end if
    303303   
    304     if (config%do_lw .and. config%do_clouds) then
     304    if (config%do_lw .AND. config%do_clouds) then
    305305      call out_file%define_variable("cloud_cover_lw", &
    306306           &  dim1_name="column", units_str="1", &
    … …  
    308308           &  standard_name="cloud_area_fraction")
    309309    end if
    310     if (config%do_sw .and. config%do_clouds) then
     310    if (config%do_sw .AND. config%do_clouds) then
    311311      call out_file%define_variable("cloud_cover_sw", &
    312312           &  dim1_name="column", units_str="1", &
    … …  
    398398    end if
    399399
    400     if (config%do_lw .and. config%do_clouds) then
     400    if (config%do_lw .AND. config%do_clouds) then
    401401      call out_file%put("cloud_cover_lw", flux%cloud_cover_lw)
    402402    end if
    403     if (config%do_sw .and. config%do_clouds) then
     403    if (config%do_sw .AND. config%do_clouds) then
    404404      call out_file%put("cloud_cover_sw", flux%cloud_cover_sw)
    405405    end if
    … …  
    538538         &  units_str="Pa", long_name="Pressure on half-levels")
    539539
    540     if (allocated(thermodynamics%h2o_sat_liq) .and. config%use_aerosols) then
     540    if (allocated(thermodynamics%h2o_sat_liq) .AND. config%use_aerosols) then
    541541      call out_file%define_variable("q_sat_liquid", &
    542542           &  dim2_name="column", dim1_name="level", &
    … …  
    653653    call out_file%put("pressure_hl", thermodynamics%pressure_hl(istartcol:iendcol,:))
    654654
    655     if (allocated(thermodynamics%h2o_sat_liq) .and. config%use_aerosols) then
     655    if (allocated(thermodynamics%h2o_sat_liq) .AND. config%use_aerosols) then
    656656      call out_file%put("q_sat_liquid", thermodynamics%h2o_sat_liq(istartcol:iendcol,:))
    657657    end if
    … …  
    774774    nlev = nlev - 1
    775775   
    776     do_aerosol = config%use_aerosols .and. present(aerosol)
     776    do_aerosol = config%use_aerosols .AND. present(aerosol)
    777777
    778778    ! Open the file
    … …  
    869869         &   units_str="1", long_name="Ozone mass mixing ratio")
    870870    DO jgas = 1,NMaxGases
    871       if (gas%is_present(jgas) .and. jgas /= IH2O .and. jgas /= IO3) then
     871      if (gas%is_present(jgas) .AND. jgas /= IH2O .AND. jgas /= IO3) then
    872872        write(var_name,'(a,a)') trim(GasLowerCaseName(jgas)), '_vmr'
    873873        write(long_name,'(a,a)') trim(GasName(jgas)), ' volume mixing ratio'
    … …  
    944944    end if
    945945    call out_file%put("lw_emissivity", single_level%lw_emissivity)
    946     if (config%do_clouds .and. allocated(single_level%iseed)) then
     946    if (config%do_clouds .AND. allocated(single_level%iseed)) then
    947947      allocate(seed(ncol))
    948948      seed = single_level%iseed
    … …  
    960960    call out_file%put("o3_mmr", mixing_ratio)
    961961    DO jgas = 1,NMaxGases
    962       if (gas%is_present(jgas) .and. jgas /= IH2O .and. jgas /= IO3) then
     962      if (gas%is_present(jgas) .AND. jgas /= IH2O .AND. jgas /= IO3) then
    963963        write(var_name,'(a,a)') trim(GasLowerCaseName(jgas)), '_vmr'
    964964        call gas%get(jgas, IVolumeMixingRatio, mixing_ratio)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_scheme.F90

    r5159 r5185  
    507507               &  driver_config%high_inv_effective_size, 0.8_jprb, 0.45_jprb)
    508508!  else if (driver_config%cloud_separation_scale_surface > 0.0_jprb &
    509 !         .and. driver_config%cloud_separation_scale_toa > 0.0_jprb) then
     509!         .AND. driver_config%cloud_separation_scale_toa > 0.0_jprb) then
    510510  else if (driver_config%ok_separation) then
    511511      call cloud%param_cloud_effective_separation_eta(klon, klev, &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_single_level.F90

    r5159 r5185  
    310310    end if
    311311
    312     if (config%do_lw .and. present(lw_albedo)) then
     312    if (config%do_lw .AND. present(lw_albedo)) then
    313313      if (config%use_canopy_full_spectrum_lw) then
    314314        if (config%n_g_lw /= size(this%lw_emissivity,2)) then

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_spartacus_lw.F90

    r5159 r5185  
    421421          ! region and the sky is overcast then 3D calculations must
    422422          ! be turned off as there will be only one region
    423           if (config%do_3d_effects .and. &
    424                &  allocated(cloud%inv_cloud_effective_size) .and. &
    425                &  .not. (nreg == 2 .and. cloud%fraction(jcol,jlev) &
     423          if (config%do_3d_effects .AND. &
     424               &  allocated(cloud%inv_cloud_effective_size) .AND. &
     425               &  .not. (nreg == 2 .AND. cloud%fraction(jcol,jlev) &
    426426               &  > 1.0_jprb-config%cloud_fraction_threshold)) then
    427427            if (cloud%inv_cloud_effective_size(jcol,jlev) &
    … …  
    586586            ! 3D effects for any further g-points
    587587            if (ng3D == ng &
    588                  &  .and. od_region(jg,1) > config%max_gas_od_3D) then
     588                 &  .AND. od_region(jg,1) > config%max_gas_od_3D) then
    589589              ng3D = jg-1
    590590            end if
    … …  
    637637          ! of the cloud
    638638          if (config%do_lw_side_emissivity &
    639              & .and. region_fracs(1,jlev,jcol) > 0.0_jprb .and. region_fracs(2,jlev,jcol) > 0.0_jprb &
    640              & .and. config%do_3d_effects &
    641              & .and. cloud%inv_cloud_effective_size(jcol,jlev) > 0.0_jprb) then
     639             & .AND. region_fracs(1,jlev,jcol) > 0.0_jprb .AND. region_fracs(2,jlev,jcol) > 0.0_jprb &
     640             & .AND. config%do_3d_effects &
     641             & .AND. cloud%inv_cloud_effective_size(jcol,jlev) > 0.0_jprb) then
    642642            aspect_ratio = 1.0_jprb / (min(cloud%inv_cloud_effective_size(jcol,jlev), &
    643643                 &                         1.0_jprb / config%min_cloud_effective_size) &
    … …  
    894894        ! source below a layer interface to the equivalent values
    895895        ! just above
    896         if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1)) then
     896        if (is_clear_sky_layer(jlev) .AND. is_clear_sky_layer(jlev-1)) then
    897897          ! If both layers are cloud free, this is trivial...
    898898          total_albedo(:,:,:,jlev) = 0.0_jprb
    … …  
    10141014        ! Account for overlap rules in translating fluxes just above
    10151015        ! a layer interface to the values just below
    1016         if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev+1)) then
     1016        if (is_clear_sky_layer(jlev) .AND. is_clear_sky_layer(jlev+1)) then
    10171017          flux_dn_below = flux_dn_above
    10181018        else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_spartacus_sw.F90

    r5159 r5185  
    494494          end if
    495495
    496           if (config%do_3d_effects .and. &
    497                &  allocated(cloud%inv_cloud_effective_size) .and. &
    498                &  .not. (nreg == 2 .and. cloud%fraction(jcol,jlev) &
     496          if (config%do_3d_effects .AND. &
     497               &  allocated(cloud%inv_cloud_effective_size) .AND. &
     498               &  .not. (nreg == 2 .AND. cloud%fraction(jcol,jlev) &
    499499               &  > 1.0-config%cloud_fraction_threshold)) then
    500500            if (cloud%inv_cloud_effective_size(jcol,jlev) > 0.0_jprb) then
    … …  
    663663            ! 3D effects for any further g-points
    664664            if (ng3D == ng &
    665                  &  .and. od_region(jg,1) > config%max_gas_od_3D) then
     665                 &  .AND. od_region(jg,1) > config%max_gas_od_3D) then
    666666              ng3D = jg-1
    667667            end if
    … …  
    936936        if ((config%i_3d_sw_entrapment == IEntrapmentExplicitNonFractal &
    937937             &  .or. config%i_3d_sw_entrapment == IEntrapmentExplicit) &
    938              &  .and. jlev >= i_cloud_top) then
     938             &  .AND. jlev >= i_cloud_top) then
    939939#else
    940940        if (config%i_3d_sw_entrapment == IEntrapmentExplicitNonFractal &
    … …  
    970970        ! Account for cloud overlap when converting albedo and source
    971971        ! below a layer interface to the equivalent values just above
    972         if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1)) then
     972        if (is_clear_sky_layer(jlev) .AND. is_clear_sky_layer(jlev-1)) then
    973973          ! If both layers are cloud free, this is trivial...
    974974          total_albedo(:,:,:,jlev) = 0.0_jprb
    … …  
    12181218                       &  / max(config%cloud_fraction_threshold, region_fracs(jreg,jlev,jcol))
    12191219                  DO jreg4 = 1,nreg ! VIA first lower region (jreg2 is second lower region)
    1220                     if (.not. (jreg4 == jreg .and. jreg4 /= jreg2)) then
     1220                    if (.not. (jreg4 == jreg .AND. jreg4 /= jreg2)) then
    12211221                      albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) + entrapment(:,jreg3,jreg) &
    12221222                           &  * v_matrix(jreg4,jreg,jlev,jcol) * total_albedo_below(:,jreg2,jreg4)
    … …  
    13061306                       &  / max(config%cloud_fraction_threshold, region_fracs(jreg,jlev,jcol))
    13071307                  DO jreg4 = 1,nreg
    1308                     if (.not. (jreg4 == jreg .and. jreg4 /= jreg2)) then
     1308                    if (.not. (jreg4 == jreg .AND. jreg4 /= jreg2)) then
    13091309                     albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) + entrapment(:,jreg3,jreg) &
    13101310                           &  * v_matrix(jreg4,jreg,jlev,jcol) * total_albedo_below_direct(:,jreg2,jreg4)
    … …  
    13301330        if ((config%i_3d_sw_entrapment == IEntrapmentExplicitNonFractal &
    13311331             &  .or. config%i_3d_sw_entrapment == IEntrapmentExplicit) &
    1332              &  .and. .not. (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1))) then
     1332             &  .AND. .not. (is_clear_sky_layer(jlev) .AND. is_clear_sky_layer(jlev-1))) then
    13331333          ! Horizontal migration distances are averaged when
    13341334          ! applying overlap rules, so equation is
    … …  
    15261526        ! Account for overlap rules in translating fluxes just above
    15271527        ! a layer interface to the values just below
    1528         if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev+1)) then
     1528        if (is_clear_sky_layer(jlev) .AND. is_clear_sky_layer(jlev+1)) then
    15291529          ! Regions in current layer map directly on to regions in
    15301530          ! layer below

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_spectral_definition.F90

    r5159 r5185  
    171171      find_wavenumber = 1
    172172      DO while (wavenumber > this%wavenumber2(find_wavenumber) &
    173            &    .and. find_wavenumber < this%nwav)
     173           &    .AND. find_wavenumber < this%nwav)
    174174        find_wavenumber = find_wavenumber + 1
    175175      end do
    … …  
    250250          ! will be applicable
    251251          if (wavenumber(jwav) >= this%wavenumber1_band(jband) &
    252                & .and. wavenumber(jwav) <= this%wavenumber2_band(jband)) then
     252               & .AND. wavenumber(jwav) <= this%wavenumber2_band(jband)) then
    253253            if (jwav > 1) then
    254254              wavenum1 = max(this%wavenumber1_band(jband), &
    … …  
    388388                 &       / (this%wavenumber2(isd1)-this%wavenumber1(isd1))
    389389          else
    390             if (isd2 >= 1 .and. isd2 <= this%nwav) then
     390            if (isd2 >= 1 .AND. isd2 <= this%nwav) then
    391391              ! Right part of triangle
    392392              weight(isd2) = weight(isd2) + 0.5_jprb * (wavenum2-this%wavenumber1(isd2))**2 &
    … …  
    647647        wavenumber2_bound = 0.01_jprb / wavelength_bound(jint-1)
    648648        where (wavenumber_mid > wavenumber1_bound &
    649              & .and. wavenumber_mid <= wavenumber2_bound)
     649             & .AND. wavenumber_mid <= wavenumber2_bound)
    650650          i_input = i_intervals(jint)
    651651        end where

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_tripleclouds_lw.F90

    r5159 r5185  
    340340                       &     / od_total
    341341                end where
    342                 where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
     342                where (ssa_total > 0.0_jprb .AND. od_total > 0.0_jprb)
    343343                  g_total = (g(:,jlev,jcol)*ssa(:,jlev,jcol)*od(:,jlev,jcol) &
    344344                       &     +   g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
    … …  
    352352                       &     * od_cloud_new / od_total
    353353                end where
    354                 where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
     354                where (ssa_total > 0.0_jprb .AND. od_total > 0.0_jprb)
    355355                  g_total = g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
    356356                       &     * ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
    … …  
    435435        ! Account for cloud overlap when converting albedo below a
    436436        ! layer interface to the equivalent values just above
    437         if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1)) then
     437        if (is_clear_sky_layer(jlev) .AND. is_clear_sky_layer(jlev-1)) then
    438438          total_albedo(:,:,jlev) = total_albedo_below(:,:)
    439439          total_source(:,:,jlev) = total_source_below(:,:)
    … …  
    534534
    535535        if (.not. (is_clear_sky_layer(jlev) &
    536              &    .and. is_clear_sky_layer(jlev+1))) then
     536             &    .AND. is_clear_sky_layer(jlev+1))) then
    537537          ! Account for overlap rules in translating fluxes just above
    538538          ! a layer interface to the values just below

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radiation_tripleclouds_sw.F90

    r5159 r5185  
    1818!   2017-10-23  R. Hogan  Renamed single-character variables
    1919!   2018-10-08  R. Hogan  Call calc_region_properties
    20 !   2019-01-02  R. Hogan  Fixed problem of do_save_spectral_flux .and. .not. do_sw_direct
     20!   2019-01-02  R. Hogan  Fixed problem of do_save_spectral_flux .AND. .not. do_sw_direct
    2121!   2020-09-18  R. Hogan  Replaced some array expressions with loops for speed
    2222
    … …  
    395395        ! Account for cloud overlap when converting albedo below a
    396396        ! layer interface to the equivalent values just above
    397         if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1)) then
     397        if (is_clear_sky_layer(jlev) .AND. is_clear_sky_layer(jlev-1)) then
    398398          total_albedo(:,:,jlev)        = total_albedo_below(:,:)
    399399          total_albedo_direct(:,:,jlev) = total_albedo_below_direct(:,:)
    … …  
    529529
    530530        if (.not. (is_clear_sky_layer(jlev) &
    531              &    .and. is_clear_sky_layer(jlev+1))) then
     531             &    .AND. is_clear_sky_layer(jlev+1))) then
    532532          ! Account for overlap rules in translating fluxes just above
    533533          ! a layer interface to the values just below

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/radsurf_save.F90

    r5159 r5185  
    7575
    7676      if (config%i_gas_model == IGasModelMonochromatic &
    77            .and. config%mono_lw_wavelength > 0.0_jprb) then
     77           .AND. config%mono_lw_wavelength > 0.0_jprb) then
    7878        lw_units_str = 'W m-3'
    7979      else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_driver.F90

    r5159 r5185  
    200200  end if
    201201
    202   if (driver_config%do_save_cloud_optics .and. config%use_general_cloud_optics) then
     202  if (driver_config%do_save_cloud_optics .AND. config%use_general_cloud_optics) then
    203203    call save_general_cloud_optics(config, 'hydrometeor_optics', iverbose=driver_config%iverbose)
    204204  end if

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_driver_config.F90

    r5159 r5185  
    355355
    356356    if (do_override_eff_size &
    357          &  .and. (this%high_inv_effective_size_override < 0.0_jprb &
     357         &  .AND. (this%high_inv_effective_size_override < 0.0_jprb &
    358358              .or. this%middle_inv_effective_size_override < 0.0_jprb &
    359359              .or. this%low_inv_effective_size_override < 0.0_jprb)) then

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ecrad_driver_read_input.F90

    r5159 r5185  
    103103    else
    104104      single_level%solar_irradiance = 1366.0_jprb
    105       if (driver_config%iverbose >= 1 .and. config%do_sw) then
     105      if (driver_config%iverbose >= 1 .AND. config%do_sw) then
    106106        write(nulout,'(a,g10.3,a)') 'Warning: solar irradiance set to ', &
    107107             &  single_level%solar_irradiance, ' W m-2'
    … …  
    204204      ! Optional scaling of liquid water mixing ratio
    205205      if (driver_config%q_liq_scaling >= 0.0_jprb &
    206            &  .and. driver_config%q_liq_scaling /= 1.0_jprb) then
     206           &  .AND. driver_config%q_liq_scaling /= 1.0_jprb) then
    207207        cloud%q_liq = cloud%q_liq * driver_config%q_liq_scaling
    208208        if (driver_config%iverbose >= 2) then
    … …  
    213213
    214214      ! Optional scaling of ice water mixing ratio
    215       if (driver_config%q_ice_scaling >= 0.0_jprb .and. driver_config%q_ice_scaling /= 1.0_jprb) then
     215      if (driver_config%q_ice_scaling >= 0.0_jprb .AND. driver_config%q_ice_scaling /= 1.0_jprb) then
    216216        cloud%q_ice = cloud%q_ice * driver_config%q_ice_scaling
    217217        if (driver_config%iverbose >= 2) then
    … …  
    223223      ! Optional scaling of cloud fraction
    224224      if (driver_config%cloud_fraction_scaling >= 0.0_jprb &
    225            &  .and. driver_config%cloud_fraction_scaling /= 1.0_jprb) then
     225           &  .AND. driver_config%cloud_fraction_scaling /= 1.0_jprb) then
    226226        cloud%fraction = cloud%fraction * driver_config%cloud_fraction_scaling
    227227        if (driver_config%iverbose >= 2) then
    … …  
    332332
    333333        else if (driver_config%cloud_separation_scale_surface > 0.0_jprb &
    334              &  .and. driver_config%cloud_separation_scale_toa > 0.0_jprb) then
     334             &  .AND. driver_config%cloud_separation_scale_toa > 0.0_jprb) then
    335335          ! (2) Cloud separation scale provided in namelist
    336336
    … …  
    386386          allocate(cloud%inv_inhom_effective_size(ncol,nlev))
    387387          where (cloud%fraction > config%cloud_fraction_threshold &
    388                &  .and. cloud%fraction < 1.0_jprb - config%cloud_fraction_threshold)
     388               &  .AND. cloud%fraction < 1.0_jprb - config%cloud_fraction_threshold)
    389389            ! Convert effective cloud separation to effective cloud
    390390            ! size, noting divisions rather than multiplications
    … …  
    442442        ! In cases (3) and (4) above the effective size obtained from
    443443        ! the NetCDF may be scaled by a namelist variable
    444         if (is_cloud_size_scalable .and. driver_config%effective_size_scaling > 0.0_jprb) then
     444        if (is_cloud_size_scalable .AND. driver_config%effective_size_scaling > 0.0_jprb) then
    445445          ! Scale cloud effective size
    446446          cloud%inv_cloud_effective_size = cloud%inv_cloud_effective_size &
    … …  
    477477      allocate(single_level%skin_temperature(ncol))
    478478      single_level%skin_temperature(1:ncol) = thermodynamics%temperature_hl(1:ncol,nlev+1)
    479       if (driver_config%iverbose >= 1 .and. config%do_lw &
    480            &  .and. driver_config%skin_temperature_override < 0.0_jprb) then
     479      if (driver_config%iverbose >= 1 .AND. config%do_lw &
     480           &  .AND. driver_config%skin_temperature_override < 0.0_jprb) then
    481481        write(nulout,'(a)') 'Warning: skin temperature set equal to lowest air temperature'
    482482      end if

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ifs_blocking.F90

    r5159 r5185  
    7373  lldebug=(driver_config%iverbose>4)     ! debug
    7474  llactaero = .false.
    75   if(yradiation%rad_config%n_aerosol_types > 0 .and.&
    76     & yradiation%rad_config%n_aerosol_types <= 21 .and. yradiation%yrerad%naermacc == 0) then
     75  if(yradiation%rad_config%n_aerosol_types > 0 .AND.&
     76    & yradiation%rad_config%n_aerosol_types <= 21 .AND. yradiation%yrerad%naermacc == 0) then
    7777    llactaero = .true.
    7878  endif
    … …  
    121121  ifs_config%ihti   =indrad(inext,nlev+1,.true.)
    122122  ifs_config%iaero  =indrad(inext,yradiation%rad_config%n_aerosol_types*nlev,&
    123                           & llactaero .and. yradiation%yrerad%naermacc==0)
     123                          & llactaero .AND. yradiation%yrerad%naermacc==0)
    124124
    125125  iinend =inext-1                  ! end of input variables

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/ifsaux/abor1.F90

    r5159 r5185  
    2323  ! FLUSH not understood by NAG compiler
    2424  !CALL FLUSH(NULOUT)
    25   IF (NULOUT /= 0 .and. NULOUT /= 6) CLOSE(NULOUT)
     25  IF (NULOUT /= 0 .AND. NULOUT /= 6) CLOSE(NULOUT)
    2626ENDIF
    2727

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_aerosol_optics.F90

    r5159 r5185  
    292292          else
    293293            iwn = 1
    294             DO while (wavenumber(iwn+1) < wavenumber_target .and. iwn < nwn-1)
     294            DO while (wavenumber(iwn+1) < wavenumber_target .AND. iwn < nwn-1)
    295295              iwn = iwn + 1
    296296            end do
    … …  
    756756              iband = config%i_band_from_reordered_g_sw(jg)
    757757              local_od = od_sw(jg,jlev,jcol) + od_sw_aerosol(iband,jlev)
    758               if (local_od > 0.0_jprb .and. od_sw_aerosol(iband,jlev) > 0.0_jprb) then
     758              if (local_od > 0.0_jprb .AND. od_sw_aerosol(iband,jlev) > 0.0_jprb) then
    759759                local_scat = ssa_sw(jg,jlev,jcol) * od_sw(jg,jlev,jcol) &
    760760                     &  + scat_sw_aerosol(iband,jlev)
    … …  
    785785              iband = config%i_band_from_reordered_g_lw(jg)
    786786              local_od = od_lw(jg,jlev,jcol) + od_lw_aerosol(iband,jlev)
    787               if (local_od > 0.0_jprb .and. od_lw_aerosol(iband,jlev) > 0.0_jprb) then
     787              if (local_od > 0.0_jprb .AND. od_lw_aerosol(iband,jlev) > 0.0_jprb) then
    788788                ! All scattering is due to aerosols, therefore the
    789789                ! asymmetry factor is equal to the value for aerosols

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_aerosol_optics_data.F90

    r5159 r5185  
    378378    end if
    379379
    380     if (n_type_philic > 0 .and. nrh > 0) then
     380    if (n_type_philic > 0 .AND. nrh > 0) then
    381381      if (n_bands_sw > 0) then
    382382        allocate(this%mass_ext_sw_philic(n_bands_sw, nrh, n_type_philic))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_aerosol_optics_description.F90

    r5159 r5185  
    168168      ! Check if we have a match
    169169      if (to_string(this%code_philic(:,ja)) == code_str &
    170            &  .and. trim(to_string(this%optical_model_philic(:,ja))) &
     170           &  .AND. trim(to_string(this%optical_model_philic(:,ja))) &
    171171           &          == optical_model_str) then
    172172        this%is_preferred_philic(ja) = .true.
    … …  
    178178    DO ja = 1,size(this%bin_phobic)
    179179      if (to_string(this%code_phobic(:,ja)) == code_str &
    180            &  .and. trim(to_string(this%optical_model_phobic(:,ja))) &
     180           &  .AND. trim(to_string(this%optical_model_phobic(:,ja))) &
    181181           &          == optical_model_str) then
    182182        this%is_preferred_phobic(ja) = .true.
    … …  
    259259        if (to_string(this%code_philic(:,ja)) == code_str) then
    260260          ! Aerosol code matches
    261           if (present(ibin) .and. this%bin_philic(ja) > 0) then
     261          if (present(ibin) .AND. this%bin_philic(ja) > 0) then
    262262            if (ibin > 0) then
    263263              if (ibin == this%bin_philic(ja)) then
    … …  
    291291            current_score = current_score + 2
    292292          end if
    293           if (current_score > 0 .and. this%is_preferred_philic(ja)) then
     293          if (current_score > 0 .AND. this%is_preferred_philic(ja)) then
    294294            current_score = current_score + 1
    295295          end if
    … …  
    299299            score = current_score
    300300            is_ambiguous = .false.
    301           else if (current_score > 0 .and. current_score == score) then
     301          else if (current_score > 0 .AND. current_score == score) then
    302302            is_ambiguous = .true.
    303303          end if
    … …  
    310310        if (to_string(this%code_phobic(:,ja)) == code_str) then
    311311          ! Aerosol code matches
    312           if (present(ibin) .and. this%bin_phobic(ja) > 0) then
     312          if (present(ibin) .AND. this%bin_phobic(ja) > 0) then
    313313            if (ibin > 0) then
    314314              if (ibin == this%bin_phobic(ja)) then
    … …  
    342342            current_score = current_score + 2
    343343          end if
    344           if (current_score > 0 .and. this%is_preferred_phobic(ja)) then
     344          if (current_score > 0 .AND. this%is_preferred_phobic(ja)) then
    345345            current_score = current_score + 1
    346346          end if
    … …  
    350350            score = current_score
    351351            is_ambiguous = .false.
    352           else if (current_score > 0 .and. current_score == score) then
     352          else if (current_score > 0 .AND. current_score == score) then
    353353            is_ambiguous = .true.
    354354          end if         

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_check.F90

    r5159 r5185  
    4848    if (allocated(var)) then
    4949
    50       if (present(i1) .and. present(i2)) then
     50      if (present(i1) .AND. present(i2)) then
    5151        varmin = minval(var(i1:i2))
    5252        varmax = maxval(var(i1:i2))
    … …  
    6262        is_bad = .true.
    6363        if (do_fix) then
    64           if (present(i1) .and. present(i2)) then
     64          if (present(i1) .AND. present(i2)) then
    6565            var(i1:i2) = max(boundmin, min(boundmax, var(i1:i2)))
    6666          else
    … …  
    105105    if (allocated(var)) then
    106106
    107       if (present(i1) .and. present(i2)) then
     107      if (present(i1) .AND. present(i2)) then
    108108        ii1 = i1
    109109        ii2 = i2
    … …  
    112112        ii2 = ubound(var,1)
    113113      end if
    114       if (present(j1) .and. present(j2)) then
     114      if (present(j1) .AND. present(j2)) then
    115115        jj1 = j1
    116116        jj2 = j2
    … …  
    168168    if (allocated(var)) then
    169169
    170       if (present(i1) .and. present(i2)) then
     170      if (present(i1) .AND. present(i2)) then
    171171        ii1 = i1
    172172        ii2 = i2
    … …  
    175175        ii2 = ubound(var,1)
    176176      end if
    177       if (present(j1) .and. present(j2)) then
     177      if (present(j1) .AND. present(j2)) then
    178178        jj1 = j1
    179179        jj2 = j2
    … …  
    182182        jj2 = ubound(var,2)
    183183      end if
    184       if (present(k1) .and. present(k2)) then
     184      if (present(k1) .AND. present(k2)) then
    185185        kk1 = k1
    186186        kk2 = k2

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloud_generator.F90

    r5159 r5185  
    213213          trigger = rand_top(jg) * total_cloud_cover
    214214          jlev = ibegin
    215           DO while (trigger > cum_cloud_cover(jlev) .and. jlev < iend)
     215          DO while (trigger > cum_cloud_cover(jlev) .AND. jlev < iend)
    216216            jlev = jlev + 1
    217217          end do
    … …  
    693693
    694694          ! For each spectral interval, has the first cloud appeared at this level?
    695           first_cloud(jg) = (trigger(jg) <= cum_cloud_cover(jlev) .and. .not. found_cloud(jg))
     695          first_cloud(jg) = (trigger(jg) <= cum_cloud_cover(jlev) .AND. .not. found_cloud(jg))
    696696
    697697          ! ...if so, add to found_cloud
    … …  
    703703          ! prev_cloud)
    704704          is_cloud(jg) = first_cloud(jg) &
    705                &  .or. found_cloud(jg) .and. merge(rand_cloud(jg,jlev)*frac(jlev-1) &
     705               &  .or. found_cloud(jg) .AND. merge(rand_cloud(jg,jlev)*frac(jlev-1) &
    706706               &               < frac(jlev)+frac(jlev-1)-pair_cloud_cover(jlev-1), &
    707707               &             rand_cloud(jg,jlev)*(cum_cloud_cover(jlev-1) - frac(jlev-1)) &
    … …  
    716716          rand_inhom(jg,jlev) = merge(merge(rand_inhom(jg,jlev-1), rand_inhom(jg,jlev), &
    717717               &                           rand_inhom2(jg,jlev) < overlap_param_inhom(jlev-1) &
    718                &                           .and. prev_cloud(jg)), &
     718               &                           .AND. prev_cloud(jg)), &
    719719               &                     0.0_jprb, is_cloud(jg))
    720720        end do

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_cloud_optics.F90

    r5159 r5185  
    137137      end if
    138138    else if (config%i_ice_model == IIceModelBaran &
    139          &  .and. size(config%cloud_optics%ice_coeff_lw, 2) &
     139         &  .AND. size(config%cloud_optics%ice_coeff_lw, 2) &
    140140         &  /= NIceOpticsCoeffsBaran) then
    141141      write(nulerr,'(a,i0,a,i0,a,i0,a)') &
    … …  
    145145      call radiation_abort()
    146146    else if (config%i_ice_model == IIceModelBaran2016 &
    147          &  .and. size(config%cloud_optics%ice_coeff_lw, 2) &
     147         &  .AND. size(config%cloud_optics%ice_coeff_lw, 2) &
    148148         &  /= NIceOpticsCoeffsBaran2016) then
    149149      write(nulerr,'(a,i0,a,i0,a,i0,a)') &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_config.F90

    r5159 r5185  
    852852    use_updated_solar_spectrum    = this%use_updated_solar_spectrum
    853853
    854     if (present(file_name) .and. present(unit)) then
     854    if (present(file_name) .AND. present(unit)) then
    855855      write(nulerr,'(a)') '*** Error: cannot specify both file_name and unit in call to config_type%read'
    856856      call radiation_abort('Radiation configuration error')
    857     else if (.not. present(file_name) .and. .not. present(unit)) then
     857    else if (.not. present(file_name) .AND. .not. present(unit)) then
    858858      write(nulerr,'(a)') '*** Error: neither file_name nor unit specified in call to config_type%read'
    859859      call radiation_abort('Radiation configuration error')
    … …  
    10651065
    10661066    ! Will clouds be used at all?
    1067     if ((this%do_sw .and. this%i_solver_sw /= ISolverCloudless) &
    1068          &  .or. (this%do_lw .and. this%i_solver_lw /= ISolverCloudless)) then
     1067    if ((this%do_sw .AND. this%i_solver_sw /= ISolverCloudless) &
     1068         &  .or. (this%do_lw .AND. this%i_solver_lw /= ISolverCloudless)) then
    10691069      this%do_clouds = .true.
    10701070    else
    … …  
    10731073
    10741074    if (this%use_general_cloud_optics .or. this%use_general_aerosol_optics) then
    1075       if (this%do_sw .and. this%do_cloud_aerosol_per_sw_g_point &
    1076            &  .and. this%i_gas_model_sw == IGasModelIFSRRTMG) then
     1075      if (this%do_sw .AND. this%do_cloud_aerosol_per_sw_g_point &
     1076           &  .AND. this%i_gas_model_sw == IGasModelIFSRRTMG) then
    10771077        write(nulout,'(a)') 'Warning: RRTMG SW only supports cloud/aerosol/surface optical properties per band, not per g-point'
    10781078        this%do_cloud_aerosol_per_sw_g_point = .false.
    10791079      end if
    1080       if (this%do_lw .and. this%do_cloud_aerosol_per_lw_g_point &
    1081            &  .and. this%i_gas_model_lw == IGasModelIFSRRTMG) then
     1080      if (this%do_lw .AND. this%do_cloud_aerosol_per_lw_g_point &
     1081           &  .AND. this%i_gas_model_lw == IGasModelIFSRRTMG) then
    10821082        write(nulout,'(a)') 'Warning: RRTMG LW only supports cloud/aerosol/surface optical properties per band, not per g-point'
    10831083        this%do_cloud_aerosol_per_lw_g_point = .false.
    … …  
    11131113
    11141114    ! Check consistency of models
    1115     if (this%do_canopy_fluxes_sw .and. .not. this%do_surface_sw_spectral_flux) then
     1115    if (this%do_canopy_fluxes_sw .AND. .not. this%do_surface_sw_spectral_flux) then
    11161116      if (this%iverbosesetup >= 1) then
    11171117        write(nulout,'(a)') 'Warning: turning on do_surface_sw_spectral_flux as required by do_canopy_fluxes_sw'
    … …  
    11211121
    11221122    ! Will clouds be used at all?
    1123     if ((this%do_sw .and. this%i_solver_sw /= ISolverCloudless) &
    1124          &  .or. (this%do_lw .and. this%i_solver_lw /= ISolverCloudless)) then
     1123    if ((this%do_sw .AND. this%i_solver_sw /= ISolverCloudless) &
     1124         &  .or. (this%do_lw .AND. this%i_solver_lw /= ISolverCloudless)) then
    11251125      this%do_clouds = .true.
    11261126    else
    … …  
    11331133         & .or. this%i_solver_sw == ISolverTripleclouds &
    11341134         & .or. this%i_solver_lw == ISolverTripleclouds) &
    1135          & .and. this%i_overlap_scheme /= IOverlapExponentialRandom) then
     1135         & .AND. this%i_overlap_scheme /= IOverlapExponentialRandom) then
    11361136      write(nulerr,'(a)') '*** Error: SPARTACUS/Tripleclouds solvers can only do Exponential-Random overlap'
    11371137      call radiation_abort('Radiation configuration error')
    11381138    end if
    11391139
    1140     if (jprb < jprd .and. this%iverbosesetup >= 1 &
    1141          &  .and. (this%i_solver_sw == ISolverSPARTACUS &
     1140    if (jprb < jprd .AND. this%iverbosesetup >= 1 &
     1141         &  .AND. (this%i_solver_sw == ISolverSPARTACUS &
    11421142         &    .or. this%i_solver_lw == ISolverSPARTACUS)) then
    11431143      write(nulout,'(a)') 'Warning: the SPARTACUS solver may be unstable in single precision'
    … …  
    12971297    end if
    12981298
    1299     if (this%use_aerosols .and. this%n_aerosol_types == 0) then
     1299    if (this%use_aerosols .AND. this%n_aerosol_types == 0) then
    13001300      if (this%iverbosesetup >= 2) then
    13011301        write(nulout, '(a)') 'Aerosols on but n_aerosol_types=0: optical properties to be computed outside ecRad'
    … …  
    13241324    end if
    13251325
    1326     if (this%i_solver_sw == ISolverSPARTACUS .and. this%do_sw_delta_scaling_with_gases) then
     1326    if (this%i_solver_sw == ISolverSPARTACUS .AND. this%do_sw_delta_scaling_with_gases) then
    13271327      write(nulerr,'(a)') '*** Error: SW delta-Eddington scaling with gases not possible with SPARTACUS solver'
    13281328      call radiation_abort('Radiation configuration error')
    13291329    end if
    13301330
    1331     if ((this%do_lw .and. this%do_sw) .and. &
     1331    if ((this%do_lw .AND. this%do_sw) .AND. &
    13321332         & (     (      this%i_solver_sw == ISolverHomogeneous  &
    1333          &        .and. this%i_solver_lw /= ISolverHomogeneous) &
     1333         &        .AND. this%i_solver_lw /= ISolverHomogeneous) &
    13341334         &  .or. (      this%i_solver_sw /= ISolverHomogeneous  &
    1335          &        .and. this%i_solver_lw == ISolverHomogeneous) &
     1335         &        .AND. this%i_solver_lw == ISolverHomogeneous) &
    13361336         & ) ) then
    13371337      write(nulerr,'(a)') '*** Error: if one solver is "Homogeneous" then the other must be'
    … …  
    13411341    ! Set is_homogeneous if the active solvers are homogeneous, since
    13421342    ! this affects how "in-cloud" water contents are computed
    1343     if (        (this%do_sw .and. this%i_solver_sw == ISolverHomogeneous) &
    1344          & .or. (this%do_lw .and. this%i_solver_lw == ISolverHomogeneous)) then
     1343    if (        (this%do_sw .AND. this%i_solver_sw == ISolverHomogeneous) &
     1344         & .or. (this%do_lw .AND. this%i_solver_lw == ISolverHomogeneous)) then
    13451345      this%is_homogeneous = .true.
    13461346    end if
    … …  
    16691669           &  wavelength1, ' to ', wavelength2, ' m is outside shortwave band'
    16701670      call radiation_abort('Radiation configuration error')
    1671     else if (this%iverbosesetup >= 2 .and. present(weighting_name)) then
     1671    else if (this%iverbosesetup >= 2 .AND. present(weighting_name)) then
    16721672      write(nulout,'(a,a,a,f6.0,a,f6.0,a)') 'Spectral weights for ', &
    16731673           &  weighting_name, ' (', wavenumber1, ' to ', &
    … …  
    17411741    mapping = mapping_local(2:ninterval+1,:)
    17421742
    1743     if (this%iverbosesetup >= 2 .and. present(weighting_name)) then
     1743    if (this%iverbosesetup >= 2 .AND. present(weighting_name)) then
    17441744      write(nulout,'(a,a)') 'Spectral mapping generated for ', &
    17451745           &  weighting_name

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_ecckd.F90

    r5159 r5185  
    376376      DO jwav = 1,nwav-1
    377377        if (wavenumber(jwav) < wavenumber_grid(jwav_grid) &
    378              &  .and. wavenumber(jwav+1) >= wavenumber_grid(jwav_grid)) then
     378             &  .AND. wavenumber(jwav+1) >= wavenumber_grid(jwav_grid)) then
    379379          ! Linear interpolation - this is not perfect
    380380          ssi_grid(jwav_grid) = (ssi(jwav)*(wavenumber(jwav+1)-wavenumber_grid(jwav_grid)) &
    … …  
    650650
    651651      ! Rayleigh scattering
    652       if (this%is_sw .and. present(rayleigh_od_fl)) then
     652      if (this%is_sw .AND. present(rayleigh_od_fl)) then
    653653        DO jlev = 1,nlev
    654654          rayleigh_od_fl(:,jlev,jcol) = global_multiplier &
    … …  
    875875
    876876      ! Rayleigh scattering
    877       if (this%is_sw .and. present(rayleigh_od_fl)) then
     877      if (this%is_sw .AND. present(rayleigh_od_fl)) then
    878878        DO jcol = istartcol,iendcol
    879879          DO jlev = 1,nlev

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_ecckd_interface.F90

    r5159 r5185  
    3939    if (lhook) call dr_hook('radiation_ecckd_interface:setup_gas_optics',0,hook_handle)
    4040
    41     if (config%do_sw .and. config%i_gas_model_sw == IGasModelECCKD) then
     41    if (config%do_sw .AND. config%i_gas_model_sw == IGasModelECCKD) then
    4242
    4343      ! Read shortwave ecCKD gas optics NetCDF file
    … …  
    8484    end if
    8585
    86     if (config%do_lw .and. config%i_gas_model_lw == IGasModelECCKD) then
     86    if (config%do_lw .AND. config%i_gas_model_lw == IGasModelECCKD) then
    8787
    8888      ! Read longwave ecCKD gas optics NetCDF file
    … …  
    255255    end if
    256256   
    257     if (config%do_sw .and. config%i_gas_model_sw == IGasModelECCKD) then
     257    if (config%do_sw .AND. config%i_gas_model_sw == IGasModelECCKD) then
    258258
    259259      if (is_volume_mixing_ratio) then
    … …  
    293293    end if
    294294
    295     if (config%do_lw .and. config%i_gas_model_lw == IGasModelECCKD) then
     295    if (config%do_lw .AND. config%i_gas_model_lw == IGasModelECCKD) then
    296296
    297297      if (is_volume_mixing_ratio) then

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_flux.F90

    r5159 r5185  
    414414    if (lhook) call dr_hook('radiation_flux:calc_surface_spectral',0,hook_handle)
    415415
    416     if (config%do_sw .and. config%do_surface_sw_spectral_flux) then
     416    if (config%do_sw .AND. config%do_surface_sw_spectral_flux) then
    417417
    418418      if (use_indexed_sum_vec) then
    … …  
    473473
    474474    ! Fluxes in bands required for canopy radiative transfer
    475     if (config%do_sw .and. config%do_canopy_fluxes_sw) then
     475    if (config%do_sw .AND. config%do_canopy_fluxes_sw) then
    476476      if (config%use_canopy_full_spectrum_sw) then
    477477        this%sw_dn_diffuse_surf_canopy(:,istartcol:iendcol) = this%sw_dn_diffuse_surf_g(:,istartcol:iendcol)
    … …  
    525525    end if ! do_canopy_fluxes_sw
    526526
    527     if (config%do_lw .and. config%do_canopy_fluxes_lw) then
     527    if (config%do_lw .AND. config%do_canopy_fluxes_lw) then
    528528      if (config%use_canopy_full_spectrum_lw) then
    529529        this%lw_dn_surf_canopy(:,istartcol:iendcol) = this%lw_dn_surf_g(:,istartcol:iendcol)
    … …  
    592592    if (lhook) call dr_hook('radiation_flux:calc_toa_spectral',0,hook_handle)
    593593
    594     if (config%do_sw .and. config%do_toa_spectral_flux) then
     594    if (config%do_sw .AND. config%do_toa_spectral_flux) then
    595595
    596596      if (use_indexed_sum_vec) then
    … …  
    627627    end if
    628628
    629     if (config%do_lw .and. config%do_toa_spectral_flux) then
     629    if (config%do_lw .AND. config%do_toa_spectral_flux) then
    630630
    631631      if (use_indexed_sum_vec) then

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_gas.F90

    r5159 r5185  
    380380      if (this%is_present(igas)) then
    381381        if (iunits == IMassMixingRatio &
    382              &   .and. this%iunits(igas) == IVolumeMixingRatio) then
     382             &   .AND. this%iunits(igas) == IVolumeMixingRatio) then
    383383          sf = sf * GasMolarMass(igas) / AirMolarMass
    384384        else if (iunits == IVolumeMixingRatio &
    385              &   .and. this%iunits(igas) == IMassMixingRatio) then
     385             &   .AND. this%iunits(igas) == IMassMixingRatio) then
    386386          sf = sf * AirMolarMass / GasMolarMass(igas)
    387387        end if
    … …  
    417417    scaling = this%scale_factor
    418418    DO jg = 1,NMaxGases
    419       if (iunits == IMassMixingRatio .and. this%iunits(jg) == IVolumeMixingRatio) then
     419      if (iunits == IMassMixingRatio .AND. this%iunits(jg) == IVolumeMixingRatio) then
    420420        scaling(jg) = scaling(jg) * GasMolarMass(jg) / AirMolarMass
    421       else if (iunits == IVolumeMixingRatio .and. this%iunits(jg) == IMassMixingRatio) then
     421      else if (iunits == IVolumeMixingRatio .AND. this%iunits(jg) == IMassMixingRatio) then
    422422        scaling(jg) = scaling(jg) * AirMolarMass / GasMolarMass(jg)
    423423      end if
    … …  
    544544    else
    545545      if (iunits == IMassMixingRatio &
    546            &   .and. this%iunits(igas) == IVolumeMixingRatio) then
     546           &   .AND. this%iunits(igas) == IVolumeMixingRatio) then
    547547        sf = sf * GasMolarMass(igas) / AirMolarMass
    548548      else if (iunits == IVolumeMixingRatio &
    549            &   .and. this%iunits(igas) == IMassMixingRatio) then
     549           &   .AND. this%iunits(igas) == IMassMixingRatio) then
    550550        sf = sf * AirMolarMass / GasMolarMass(igas)
    551551      end if

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_homogeneous_lw.F90

    r5159 r5185  
    221221                       &     / od_total
    222222                end where
    223                 where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
     223                where (ssa_total > 0.0_jprb .AND. od_total > 0.0_jprb)
    224224                  g_total = (g(:,jlev,jcol)*ssa(:,jlev,jcol)*od(:,jlev,jcol) &
    225225                       &     +   g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
    … …  
    233233                       &     * od_cloud_g / od_total
    234234                end where
    235                 where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
     235                where (ssa_total > 0.0_jprb .AND. od_total > 0.0_jprb)
    236236                  g_total = g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
    237237                       &     * ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_homogeneous_sw.F90

    r5159 r5185  
    244244                     &     / od_total
    245245              end where
    246               where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
     246              where (ssa_total > 0.0_jprb .AND. od_total > 0.0_jprb)
    247247                g_total = (g(:,jlev,jcol)*ssa(:,jlev,jcol)*od(:,jlev,jcol) &
    248248                     &     +   g_cloud(config%i_band_from_reordered_g_sw,jlev,jcol) &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_ifs_rrtm.F90

    r5159 r5185  
    8181    if (lhook) call dr_hook('radiation_ifs_rrtm:setup_gas_optics',0,hook_handle)
    8282
    83     do_sw = (config%do_sw .and. config%i_gas_model_sw == IGasModelIFSRRTMG)
    84     do_lw = (config%do_lw .and. config%i_gas_model_lw == IGasModelIFSRRTMG)
     83    do_sw = (config%do_sw .AND. config%i_gas_model_sw == IGasModelIFSRRTMG)
     84    do_lw = (config%do_lw .AND. config%i_gas_model_lw == IGasModelIFSRRTMG)
    8585   
    8686    ! The IFS implementation of RRTMG uses many global variables.  In
    … …  
    373373    if (lhook) call dr_hook('radiation_ifs_rrtm:gas_optics',0,hook_handle)
    374374
    375     do_sw = (config%do_sw .and. config%i_gas_model_sw == IGasModelIFSRRTMG)
    376     do_lw = (config%do_lw .and. config%i_gas_model_lw == IGasModelIFSRRTMG)
     375    do_sw = (config%do_sw .AND. config%i_gas_model_sw == IGasModelIFSRRTMG)
     376    do_lw = (config%do_lw .AND. config%i_gas_model_lw == IGasModelIFSRRTMG)
    377377
    378378    ! Compute start and end levels for indexing the gas mixing ratio
    … …  
    670670      DO jcol = istartcol,iendcol
    671671        temperature = thermodynamics%temperature_hl(jcol,jlev+ilevoffset)
    672         if (temperature < 339.0_jprb .and. temperature >= 160.0_jprb) then
     672        if (temperature < 339.0_jprb .AND. temperature >= 160.0_jprb) then
    673673          ! Linear interpolation between -113 and 66 degC
    674674          ind(jcol)  = int(temperature - 159.0_jprb)
    … …  
    796796    DO jcol = istartcol,iendcol
    797797      Tsurf = temperature(jcol)
    798       if (Tsurf < 339.0_jprb .and. Tsurf >= 160.0_jprb) then
     798      if (Tsurf < 339.0_jprb .AND. Tsurf >= 160.0_jprb) then
    799799        ! Linear interpolation between -113 and 66 degC
    800800        ind(jcol)  = int(Tsurf - 159.0_jprb)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_interface.F90

    r5159 r5185  
    8383
    8484    if (config%do_lw_aerosol_scattering &
    85          & .and. .not. config%do_lw_cloud_scattering) then
     85         & .AND. .not. config%do_lw_cloud_scattering) then
    8686      write(nulerr, '(a)') '*** Error: longwave aerosol scattering requires longwave cloud scattering'
    8787      call radiation_abort('Radiation configuration error')
    … …  
    114114    ! solver_lw as they will be needed.
    115115    if (config%do_lw_cloud_scattering &
    116          &  .and. config%i_solver_lw == ISolverMcICA) then
     116         &  .AND. config%i_solver_lw == ISolverMcICA) then
    117117      config%n_g_lw_if_scattering = config%n_g_lw
    118118    end if
    … …  
    404404      ! a NetCDF file
    405405      if (config%do_save_radiative_properties) then
    406         if (istartcol == 1 .and. iendcol == ncol) then
     406        if (istartcol == 1 .AND. iendcol == ncol) then
    407407          rad_prop_file_name = rad_prop_base_file_name // ".nc"
    408408        else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_save.F90

    r5159 r5185  
    8787
    8888    if (config%i_gas_model_lw == IGasModelMonochromatic &
    89          .and. config%mono_lw_wavelength > 0.0_jprb) then
     89         .AND. config%mono_lw_wavelength > 0.0_jprb) then
    9090      lw_units_str = 'W m-3'
    9191    else
    … …  
    127127    end if
    128128
    129     if (config%do_lw .and. config%do_canopy_fluxes_lw) then
     129    if (config%do_lw .AND. config%do_canopy_fluxes_lw) then
    130130      call out_file%define_dimension("canopy_band_lw", &
    131131           &  size(flux%lw_dn_surf_canopy, 1))
    132132    end if
    133     if (config%do_sw .and. config%do_canopy_fluxes_sw) then
     133    if (config%do_sw .AND. config%do_canopy_fluxes_sw) then
    134134      call out_file%define_dimension("canopy_band_sw", &
    135135           &  size(flux%sw_dn_diffuse_surf_canopy, 1))
    … …  
    328328    end if
    329329   
    330     if (config%do_lw .and. config%do_clouds) then
     330    if (config%do_lw .AND. config%do_clouds) then
    331331      call out_file%define_variable("cloud_cover_lw", &
    332332           &  dim1_name="column", units_str="1", &
    … …  
    334334           &  standard_name="cloud_area_fraction")
    335335    end if
    336     if (config%do_sw .and. config%do_clouds) then
     336    if (config%do_sw .AND. config%do_clouds) then
    337337      call out_file%define_variable("cloud_cover_sw", &
    338338           &  dim1_name="column", units_str="1", &
    … …  
    444444    end if
    445445
    446     if (config%do_lw .and. config%do_clouds) then
     446    if (config%do_lw .AND. config%do_clouds) then
    447447      call out_file%put("cloud_cover_lw", flux%cloud_cover_lw)
    448448    end if
    449     if (config%do_sw .and. config%do_clouds) then
     449    if (config%do_sw .AND. config%do_clouds) then
    450450      call out_file%put("cloud_cover_sw", flux%cloud_cover_sw)
    451451    end if
    … …  
    516516
    517517    if (config%i_gas_model_lw == IGasModelMonochromatic &
    518          .and. config%mono_lw_wavelength > 0.0_jprb) then
     518         .AND. config%mono_lw_wavelength > 0.0_jprb) then
    519519      lw_units_str = 'W m-3'
    520520    else
    … …  
    543543    call out_file%define_dimension("half_level", n_lev_plus1)
    544544
    545     if (config%do_lw .and. config%do_canopy_fluxes_lw) then
     545    if (config%do_lw .AND. config%do_canopy_fluxes_lw) then
    546546      call out_file%define_dimension("canopy_band_lw", &
    547547           &  size(flux%lw_dn_surf_canopy, 1))
    548548    end if
    549     if (config%do_sw .and. config%do_canopy_fluxes_sw) then
     549    if (config%do_sw .AND. config%do_canopy_fluxes_sw) then
    550550      call out_file%define_dimension("canopy_band_sw", &
    551551           &  size(flux%sw_dn_diffuse_surf_canopy, 1))
    … …  
    838838         &  units_str="Pa", long_name="Pressure on half-levels")
    839839
    840     if (allocated(thermodynamics%h2o_sat_liq) .and. config%use_aerosols) then
     840    if (allocated(thermodynamics%h2o_sat_liq) .AND. config%use_aerosols) then
    841841      call out_file%define_variable("q_sat_liquid", &
    842842           &  dim2_name="column", dim1_name="level", &
    … …  
    953953    call out_file%put("pressure_hl", thermodynamics%pressure_hl(istartcol:iendcol,:))
    954954
    955     if (allocated(thermodynamics%h2o_sat_liq) .and. config%use_aerosols) then
     955    if (allocated(thermodynamics%h2o_sat_liq) .AND. config%use_aerosols) then
    956956      call out_file%put("q_sat_liquid", thermodynamics%h2o_sat_liq(istartcol:iendcol,:))
    957957    end if
    … …  
    10741074    nlev = nlev - 1
    10751075   
    1076     do_aerosol = config%use_aerosols .and. present(aerosol)
     1076    do_aerosol = config%use_aerosols .AND. present(aerosol)
    10771077
    10781078    ! Open the file
    … …  
    11691169         &   units_str="1", long_name="Ozone mass mixing ratio")
    11701170    DO jgas = 1,NMaxGases
    1171       if (gas%is_present(jgas) .and. jgas /= IH2O .and. jgas /= IO3) then
     1171      if (gas%is_present(jgas) .AND. jgas /= IH2O .AND. jgas /= IO3) then
    11721172        write(var_name,'(a,a)') trim(GasLowerCaseName(jgas)), '_vmr'
    11731173        write(long_name,'(a,a)') trim(GasName(jgas)), ' volume mixing ratio'
    … …  
    12441244    end if
    12451245    call out_file%put("lw_emissivity", single_level%lw_emissivity)
    1246     if (config%do_clouds .and. allocated(single_level%iseed)) then
     1246    if (config%do_clouds .AND. allocated(single_level%iseed)) then
    12471247      allocate(seed(ncol))
    12481248      seed = single_level%iseed
    … …  
    12601260    call out_file%put("o3_mmr", mixing_ratio)
    12611261    DO jgas = 1,NMaxGases
    1262       if (gas%is_present(jgas) .and. jgas /= IH2O .and. jgas /= IO3) then
     1262      if (gas%is_present(jgas) .AND. jgas /= IH2O .AND. jgas /= IO3) then
    12631263        write(var_name,'(a,a)') trim(GasLowerCaseName(jgas)), '_vmr'
    12641264        call gas%get(jgas, IVolumeMixingRatio, mixing_ratio)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_single_level.F90

    r5159 r5185  
    325325    end if
    326326
    327     if (config%do_lw .and. present(lw_albedo)) then
     327    if (config%do_lw .AND. present(lw_albedo)) then
    328328      if (config%use_canopy_full_spectrum_lw) then
    329329        if (config%n_g_lw /= size(this%lw_emissivity,2)) then

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_spartacus_lw.F90

    r5159 r5185  
    421421          ! region and the sky is overcast then 3D calculations must
    422422          ! be turned off as there will be only one region
    423           if (config%do_3d_effects .and. &
    424                &  allocated(cloud%inv_cloud_effective_size) .and. &
    425                &  .not. (nreg == 2 .and. cloud%fraction(jcol,jlev) &
     423          if (config%do_3d_effects .AND. &
     424               &  allocated(cloud%inv_cloud_effective_size) .AND. &
     425               &  .not. (nreg == 2 .AND. cloud%fraction(jcol,jlev) &
    426426               &  > 1.0_jprb-config%cloud_fraction_threshold)) then
    427427            if (cloud%inv_cloud_effective_size(jcol,jlev) &
    … …  
    586586            ! 3D effects for any further g-points
    587587            if (ng3D == ng &
    588                  &  .and. od_region(jg,1) > config%max_gas_od_3D) then
     588                 &  .AND. od_region(jg,1) > config%max_gas_od_3D) then
    589589              ng3D = jg-1
    590590            end if
    … …  
    637637          ! of the cloud
    638638          if (config%do_lw_side_emissivity &
    639              & .and. region_fracs(1,jlev,jcol) > 0.0_jprb .and. region_fracs(2,jlev,jcol) > 0.0_jprb &
    640              & .and. config%do_3d_effects &
    641              & .and. cloud%inv_cloud_effective_size(jcol,jlev) > 0.0_jprb) then
     639             & .AND. region_fracs(1,jlev,jcol) > 0.0_jprb .AND. region_fracs(2,jlev,jcol) > 0.0_jprb &
     640             & .AND. config%do_3d_effects &
     641             & .AND. cloud%inv_cloud_effective_size(jcol,jlev) > 0.0_jprb) then
    642642            aspect_ratio = 1.0_jprb / (min(cloud%inv_cloud_effective_size(jcol,jlev), &
    643643                 &                         1.0_jprb / config%min_cloud_effective_size) &
    … …  
    894894        ! source below a layer interface to the equivalent values
    895895        ! just above
    896         if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1)) then
     896        if (is_clear_sky_layer(jlev) .AND. is_clear_sky_layer(jlev-1)) then
    897897          ! If both layers are cloud free, this is trivial...
    898898          total_albedo(:,:,:,jlev) = 0.0_jprb
    … …  
    10141014        ! Account for overlap rules in translating fluxes just above
    10151015        ! a layer interface to the values just below
    1016         if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev+1)) then
     1016        if (is_clear_sky_layer(jlev) .AND. is_clear_sky_layer(jlev+1)) then
    10171017          flux_dn_below = flux_dn_above
    10181018        else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_spartacus_sw.F90

    r5159 r5185  
    493493          end if
    494494
    495           if (config%do_3d_effects .and. &
    496                &  allocated(cloud%inv_cloud_effective_size) .and. &
    497                &  .not. (nreg == 2 .and. cloud%fraction(jcol,jlev) &
     495          if (config%do_3d_effects .AND. &
     496               &  allocated(cloud%inv_cloud_effective_size) .AND. &
     497               &  .not. (nreg == 2 .AND. cloud%fraction(jcol,jlev) &
    498498               &  > 1.0-config%cloud_fraction_threshold)) then
    499499            if (cloud%inv_cloud_effective_size(jcol,jlev) > 0.0_jprb) then
    … …  
    662662            ! 3D effects for any further g-points
    663663            if (ng3D == ng &
    664                  &  .and. od_region(jg,1) > config%max_gas_od_3D) then
     664                 &  .AND. od_region(jg,1) > config%max_gas_od_3D) then
    665665              ng3D = jg-1
    666666            end if
    … …  
    935935        if ((config%i_3d_sw_entrapment == IEntrapmentExplicitNonFractal &
    936936             &  .or. config%i_3d_sw_entrapment == IEntrapmentExplicit) &
    937              &  .and. jlev >= i_cloud_top) then
     937             &  .AND. jlev >= i_cloud_top) then
    938938#else
    939939        if (config%i_3d_sw_entrapment == IEntrapmentExplicitNonFractal &
    … …  
    969969        ! Account for cloud overlap when converting albedo and source
    970970        ! below a layer interface to the equivalent values just above
    971         if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1)) then
     971        if (is_clear_sky_layer(jlev) .AND. is_clear_sky_layer(jlev-1)) then
    972972          ! If both layers are cloud free, this is trivial...
    973973          total_albedo(:,:,:,jlev) = 0.0_jprb
    … …  
    12171217                       &  / max(config%cloud_fraction_threshold, region_fracs(jreg,jlev,jcol))
    12181218                  DO jreg4 = 1,nreg ! VIA first lower region (jreg2 is second lower region)
    1219                     if (.not. (jreg4 == jreg .and. jreg4 /= jreg2)) then
     1219                    if (.not. (jreg4 == jreg .AND. jreg4 /= jreg2)) then
    12201220                      albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) + entrapment(:,jreg3,jreg) &
    12211221                           &  * v_matrix(jreg4,jreg,jlev,jcol) * total_albedo_below(:,jreg2,jreg4)
    … …  
    13051305                       &  / max(config%cloud_fraction_threshold, region_fracs(jreg,jlev,jcol))
    13061306                  DO jreg4 = 1,nreg
    1307                     if (.not. (jreg4 == jreg .and. jreg4 /= jreg2)) then
     1307                    if (.not. (jreg4 == jreg .AND. jreg4 /= jreg2)) then
    13081308                     albedo_part(:,jreg3,jreg) = albedo_part(:,jreg3,jreg) + entrapment(:,jreg3,jreg) &
    13091309                           &  * v_matrix(jreg4,jreg,jlev,jcol) * total_albedo_below_direct(:,jreg2,jreg4)
    … …  
    13291329        if ((config%i_3d_sw_entrapment == IEntrapmentExplicitNonFractal &
    13301330             &  .or. config%i_3d_sw_entrapment == IEntrapmentExplicit) &
    1331              &  .and. .not. (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1))) then
     1331             &  .AND. .not. (is_clear_sky_layer(jlev) .AND. is_clear_sky_layer(jlev-1))) then
    13321332          ! Horizontal migration distances are averaged when
    13331333          ! applying overlap rules, so equation is
    … …  
    15251525        ! Account for overlap rules in translating fluxes just above
    15261526        ! a layer interface to the values just below
    1527         if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev+1)) then
     1527        if (is_clear_sky_layer(jlev) .AND. is_clear_sky_layer(jlev+1)) then
    15281528          ! Regions in current layer map directly on to regions in
    15291529          ! layer below

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_spectral_definition.F90

    r5159 r5185  
    202202      find_wavenumber = 1
    203203      DO while (wavenumber > this%wavenumber2(find_wavenumber) &
    204            &    .and. find_wavenumber < this%nwav)
     204           &    .AND. find_wavenumber < this%nwav)
    205205        find_wavenumber = find_wavenumber + 1
    206206      end do
    … …  
    290290          ! will be applicable
    291291          if (wavenumber(jwav) >= this%wavenumber1_band(jband) &
    292                & .and. wavenumber(jwav) <= this%wavenumber2_band(jband)) then
     292               & .AND. wavenumber(jwav) <= this%wavenumber2_band(jband)) then
    293293            if (jwav > 1) then
    294294              wavenum1 = max(this%wavenumber1_band(jband), &
    … …  
    432432                 &       / (this%wavenumber2(isd1)-this%wavenumber1(isd1))
    433433          else
    434             if (isd2 >= 1 .and. isd2 <= this%nwav) then
     434            if (isd2 >= 1 .AND. isd2 <= this%nwav) then
    435435              ! Right part of triangle
    436436              weight(isd2) = weight(isd2) + 0.5_jprb * (wavenum2-this%wavenumber1(isd2))**2 &
    … …  
    696696        wavenumber2_bound = 0.01_jprb / wavelength_bound(jint-1)
    697697        where (wavenumber_mid > wavenumber1_bound &
    698              & .and. wavenumber_mid <= wavenumber2_bound)
     698             & .AND. wavenumber_mid <= wavenumber2_bound)
    699699          i_input = i_intervals(jint)
    700700        end where

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_tripleclouds_lw.F90

    r5159 r5185  
    325325                       &     / od_total
    326326                end where
    327                 where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
     327                where (ssa_total > 0.0_jprb .AND. od_total > 0.0_jprb)
    328328                  g_total = (g(:,jlev,jcol)*ssa(:,jlev,jcol)*od(:,jlev,jcol) &
    329329                       &     +   g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
    … …  
    337337                       &     * od_cloud_new / od_total
    338338                end where
    339                 where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
     339                where (ssa_total > 0.0_jprb .AND. od_total > 0.0_jprb)
    340340                  g_total = g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
    341341                       &     * ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
    … …  
    418418        ! Account for cloud overlap when converting albedo below a
    419419        ! layer interface to the equivalent values just above
    420         if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1)) then
     420        if (is_clear_sky_layer(jlev) .AND. is_clear_sky_layer(jlev-1)) then
    421421          total_albedo(:,:,jlev) = total_albedo_below(:,:)
    422422          total_source(:,:,jlev) = total_source_below(:,:)
    … …  
    518518
    519519        if (.not. (is_clear_sky_layer(jlev) &
    520              &    .and. is_clear_sky_layer(jlev+1))) then
     520             &    .AND. is_clear_sky_layer(jlev+1))) then
    521521          ! Account for overlap rules in translating fluxes just above
    522522          ! a layer interface to the values just below

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_tripleclouds_lw.F90.or

    r4946 r5185  
    340340                       &     / od_total
    341341                end where
    342                 where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
     342                where (ssa_total > 0.0_jprb .AND. od_total > 0.0_jprb)
    343343                  g_total = (g(:,jlev,jcol)*ssa(:,jlev,jcol)*od(:,jlev,jcol) &
    344344                       &     +   g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
    … …  
    352352                       &     * od_cloud_new / od_total
    353353                end where
    354                 where (ssa_total > 0.0_jprb .and. od_total > 0.0_jprb)
     354                where (ssa_total > 0.0_jprb .AND. od_total > 0.0_jprb)
    355355                  g_total = g_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
    356356                       &     * ssa_cloud(config%i_band_from_reordered_g_lw,jlev,jcol) &
    … …  
    433433        ! Account for cloud overlap when converting albedo below a
    434434        ! layer interface to the equivalent values just above
    435         if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1)) then
     435        if (is_clear_sky_layer(jlev) .AND. is_clear_sky_layer(jlev-1)) then
    436436          total_albedo(:,:,jlev) = total_albedo_below(:,:)
    437437          total_source(:,:,jlev) = total_source_below(:,:)
    … …  
    550550
    551551        if (.not. (is_clear_sky_layer(jlev) &
    552              &    .and. is_clear_sky_layer(jlev+1))) then
     552             &    .AND. is_clear_sky_layer(jlev+1))) then
    553553          ! Account for overlap rules in translating fluxes just above
    554554          ! a layer interface to the values just below

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/radiation/radiation_tripleclouds_sw.F90

    r5159 r5185  
    1818!   2017-10-23  R. Hogan  Renamed single-character variables
    1919!   2018-10-08  R. Hogan  Call calc_region_properties
    20 !   2019-01-02  R. Hogan  Fixed problem of do_save_spectral_flux .and. .not. do_sw_direct
     20!   2019-01-02  R. Hogan  Fixed problem of do_save_spectral_flux .AND. .not. do_sw_direct
    2121!   2020-09-18  R. Hogan  Replaced some array expressions with loops for speed
    2222!   2021-10-01  P. Ukkonen Performance optimizations: batched computations
    … …  
    392392        ! Account for cloud overlap when converting albedo below a
    393393        ! layer interface to the equivalent values just above
    394         if (is_clear_sky_layer(jlev) .and. is_clear_sky_layer(jlev-1)) then
     394        if (is_clear_sky_layer(jlev) .AND. is_clear_sky_layer(jlev-1)) then
    395395          total_albedo(:,:,jlev)        = total_albedo_below(:,:)
    396396          total_albedo_direct(:,:,jlev) = total_albedo_below_direct(:,:)
    … …  
    539539       
    540540        if (.not. (is_clear_sky_layer(jlev) &
    541              &    .and. is_clear_sky_layer(jlev+1))) then
     541             &    .AND. is_clear_sky_layer(jlev+1))) then
    542542          ! Account for overlap rules in translating fluxes just above
    543543          ! a layer interface to the values just below

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/utilities/easy_netcdf.F90

    r5159 r5185  
    763763    DO j = 1, ndims
    764764      n = n * ndimlens(j)
    765       if (j > 1 .and. ndimlens(j) > 1) then
     765      if (j > 1 .AND. ndimlens(j) > 1) then
    766766        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
    767767             & var_name, &
    … …  
    821821    DO j = 1, ndims
    822822      n = n * ndimlens(j)
    823       if (j > 1 .and. ndimlens(j) > 1) then
     823      if (j > 1 .AND. ndimlens(j) > 1) then
    824824        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
    825825             & var_name, &
    … …  
    880880    DO j = 1, ndims
    881881      n = n * ndimlens(j)
    882       if (j > 1 .and. ndimlens(j) > 1) then
     882      if (j > 1 .AND. ndimlens(j) > 1) then
    883883        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
    884884             & var_name, &
    … …  
    940940    DO j = 1, ndims-1
    941941      n = n * ndimlens(j)
    942       if (j > 1 .and. ndimlens(j) > 1) then
     942      if (j > 1 .AND. ndimlens(j) > 1) then
    943943        write(nulerr,'(a,a,a)') '*** Error reading 1D slice from NetCDF variable ', &
    944944             & var_name, &
    … …  
    10231023    DO j = 1, ndims
    10241024      ntotal = ntotal * ndimlens(j)
    1025       if (j > 2 .and. ndimlens(j) > 1) then
     1025      if (j > 2 .AND. ndimlens(j) > 1) then
    10261026        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
    10271027           & var_name, &
    … …  
    11351135    DO j = 1, ndims
    11361136      ntotal = ntotal * ndimlens(j)
    1137       if (j > 2 .and. ndimlens(j) > 1) then
     1137      if (j > 2 .AND. ndimlens(j) > 1) then
    11381138        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
    11391139           & var_name, &
    … …  
    12541254    DO j = 1, ndims-1
    12551255      ntotal = ntotal * ndimlens(j)
    1256       if (j > 2 .and. ndimlens(j) > 1) then
     1256      if (j > 2 .AND. ndimlens(j) > 1) then
    12571257        write(nulerr,'(a,a,a)') '*** Error reading 2D slice from NetCDF variable ', &
    12581258           & var_name, &
    … …  
    13781378    DO j = 1, ndims
    13791379      ntotal = ntotal * ndimlens(j)
    1380       if (j > 3 .and. ndimlens(j) > 1) then
     1380      if (j > 3 .AND. ndimlens(j) > 1) then
    13811381        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
    13821382           & var_name, &
    … …  
    15141514    DO j = 1, ndims-1
    15151515      ntotal = ntotal * ndimlens(j)
    1516       if (j > 3 .and. ndimlens(j) > 1) then
     1516      if (j > 3 .AND. ndimlens(j) > 1) then
    15171517        write(nulerr,'(a,a,a)') '*** Error reading 3D slice from NetCDF variable ', &
    15181518           & var_name, &
    … …  
    16561656    DO j = 1, ndims
    16571657      ntotal = ntotal * ndimlens(j)
    1658       if (j > 4 .and. ndimlens(j) > 1) then
     1658      if (j > 4 .AND. ndimlens(j) > 1) then
    16591659        write(nulerr,'(a,a,a)') '*** Error reading NetCDF variable ', &
    16601660           & var_name, &
    … …  
    19871987    end if
    19881988
    1989     if (present(dim1_name) .and. ndims_input >= 1) then
     1989    if (present(dim1_name) .AND. ndims_input >= 1) then
    19901990      ! Variable is at least one dimensional
    19911991      ndims_local = 1
    … …  
    19961996        call my_abort('Error writing NetCDF file')
    19971997      end if
    1998       if (present(dim2_name) .and. ndims_input >= 2) then
     1998      if (present(dim2_name) .AND. ndims_input >= 2) then
    19991999        ! Variable is at least two dimensional
    20002000        ndims_local = 2
    … …  
    20052005          call my_abort('Error writing NetCDF file')
    20062006        end if
    2007         if (present(dim3_name) .and. ndims_input >= 3) then
     2007        if (present(dim3_name) .AND. ndims_input >= 3) then
    20082008          ! Variable is at least three dimensional
    20092009          ndims_local = 3
    … …  
    20142014            call my_abort('Error writing NetCDF file')
    20152015          end if
    2016           if (present(dim4_name) .and. ndims_input >= 4) then
     2016          if (present(dim4_name) .AND. ndims_input >= 4) then
    20172017            ! Variable is at least three dimensional
    20182018            ndims_local = 4
    … …  
    24722472    ! Check the total size of the variable to be stored (but receiving
    24732473    ! ntotal is zero then there must be an unlimited dimension)
    2474     if (ntotal /= size(var,kind=jpib) .and. ntotal /= 0) then
     2474    if (ntotal /= size(var,kind=jpib) .AND. ntotal /= 0) then
    24752475      write(nulerr,'(a,i0,a,a,a,i0)') '*** Error: attempt to write matrix of total size ', &
    24762476           & nvarlen, ' to ', var_name, ' which has total size ', ntotal
    … …  
    25512551      write(var_slice_name,'(a,a,i0,a)') var_name, '(:,:,', index3, ')'
    25522552    end if
    2553     if (ntotal /= size(var,kind=jpib) .and. ntotal /= 0) then
     2553    if (ntotal /= size(var,kind=jpib) .AND. ntotal /= 0) then
    25542554      write(nulerr,'(a,i0,a,a,a,i0)') '*** Error: attempt to write matrix of total size ', &
    25552555           & nvarlen, ' to ', trim(var_slice_name), ' which has total size ', ntotal

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/utilities/print_matrix.F90

    r5158 r5185  
    4747          write(unit_local,'(f16.8,$)') mat(i,j)
    4848       end do
    49        if (present(name) .and. i == size(mat,1)) then
     49       if (present(name) .AND. i == size(mat,1)) then
    5050         write(unit_local,'(a)') ']'
    5151       else

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

    r5159 r5185  
    129129  SUBROUTINE init_infotrac_phy
    130130    USE lmdz_ioipsl_getin_p, ONLY: getin_p
    131 #ifdef REPROBUS
    132    USE CHEM_REP, ONLY: Init_chem_rep_trac
    133 #endif
    134     USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_STRATAER
     131    USE lmdz_reprobus_wrappers, ONLY: Init_chem_rep_trac
     132    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_STRATAER, CPPKEY_REPROBUS
    135133    USE lmdz_abort_physic, ONLY: abort_physic
    136134    USE lmdz_iniprint, ONLY: lunout, prt_level
    137135
    138 
    139   USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     136    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    140137    IMPLICIT NONE
    141138    !==============================================================================================================================
    … …  
    224221        END IF
    225222      CASE('repr')
    226 #ifndef REPROBUS
    227         CALL abort_physic(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
    228 #endif
     223        IF (.NOT. CPPKEY_REPROBUS) THEN
     224          CALL abort_physic(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
     225        END IF
    229226      CASE('coag')
    230227        IF (.NOT. CPPKEY_STRATAER) THEN
    … …  
    309306
    310307    !--- Transfert the number of tracers to Reprobus
    311 #ifdef REPROBUS
    312    CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)
    313 #endif
     308    IF (CPPKEY_REPROBUS) THEN
     309      CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)
     310    END IF
    314311
    315312    !##############################################################################################################################

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

    r5132 r5185  
    806806  REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: budg_sed_part
    807807  !$OMP THREADPRIVATE(budg_sed_part)
    808 #ifdef REPROBUS
    809       REAL,SAVE,ALLOCATABLE    :: d_q_emiss(:,:)
    810 !$OMP THREADPRIVATE(d_q_emiss)
    811 #endif
    812808
    813809CONTAINS

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

    r5173 r5185  
    115115    USE lmdz_calcul_divers, ONLY: calcul_divers
    116116
    117     USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DUST, CPPKEY_COSP, CPPKEY_COSP2, CPPKEY_COSPV2, CPPKEY_STRATAER
     117    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DUST, CPPKEY_COSP, CPPKEY_COSP2, CPPKEY_COSPV2, CPPKEY_STRATAER, &
     118            CPPKEY_REPROBUS
    118119    USE phys_local_var_mod, ONLY: d_q_emiss
    119120    USE strataer_local_var_mod
    … …  
    124125
    125126
    126 #ifdef REPROBUS
    127     USE chem_rep, ONLY: Init_chem_rep_xjour, d_q_rep, d_ql_rep, d_qi_rep, &
     127    USE lmdz_reprobus_wrappers, ONLY: Init_chem_rep_xjour, d_q_rep, d_ql_rep, d_qi_rep, &
    128128                        ptrop, ttrop, ztrop, gravit, itroprep, Z1, Z2, fac, B
    129129    USE strataer_local_var_mod
    130130    USE strataer_emiss_mod, ONLY: strataer_emiss_init
    131 #endif
    132131
    133132#ifdef CPP_RRTM
    … …  
    18231822
    18241823      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1825 #ifdef REPROBUS
    1826        CALL strataer_init
    1827        CALL strataer_emiss_init
    1828 #endif
     1824      IF (CPPKEY_REPROBUS) THEN
     1825        CALL strataer_init
     1826        CALL strataer_emiss_init
     1827      END IF
    18291828
    18301829      IF (CPPKEY_STRATAER) THEN
    … …  
    21892188
    21902189      IF (type_trac == 'repr') THEN
    2191 #ifdef REPROBUS
    2192           CALL chemini_rep(  &
    2193                presnivs, &
    2194                pdtphys, &
    2195                annee_ref, &
    2196                day_ref,  &
    2197                day_ini, &
    2198                start_time, &
    2199                itau_phy, &
    2200                io_lon, &
    2201                io_lat)
    2202 #endif
     2190        IF (CPPKEY_REPROBUS) THEN
     2191          CALL chemini_rep(presnivs, pdtphys, annee_ref, day_ref, day_ini, start_time, itau_phy, io_lon, io_lat)
     2192        END IF
    22032193      ENDIF
    22042194
    … …  
    23002290    ! Update time and other variables in Reprobus
    23012291    IF (type_trac == 'repr') THEN
    2302 #ifdef REPROBUS
    2303        CALL Init_chem_rep_xjour(jD_cur-jD_ref+day_ref)
    2304        PRINT*,'xjour equivalent rjourvrai',jD_cur-jD_ref+day_ref
    2305        CALL Rtime(debut)
    2306 #endif
     2292      IF (CPPKEY_REPROBUS) THEN
     2293        CALL Init_chem_rep_xjour(jD_cur - jD_ref + day_ref)
     2294        PRINT*, 'xjour equivalent rjourvrai', jD_cur - jD_ref + day_ref
     2295        CALL Rtime(debut)
     2296      END IF
    23072297    ENDIF
    23082298
    … …  
    25512541
    25522542        wo(:, :, 1) = ozonecm(latitude_deg, paprs, read_climoz, rjour = zzz)
    2553 #ifdef REPROBUS
    2554           ptrop=dyn_tropopause(t_seri, ztsol, paprs, pplay, rot)/100.
     2543        IF (CPPKEY_REPROBUS) THEN
     2544          ptrop = dyn_tropopause(t_seri, ztsol, paprs, pplay, rot) / 100.
    25552545          DO i = 1, klon
    2556              Z1=t_seri(i,itroprep(i)+1)
    2557              Z2=t_seri(i,itroprep(i))
    2558              fac=(Z1-Z2)/alog(pplay(i,itroprep(i)+1)/pplay(i,itroprep(i)))
    2559              B=Z2-fac*alog(pplay(i,itroprep(i)))
    2560              ttrop(i)= fac*alog(ptrop(i))+B
    2561 
    2562              Z1= 1.e-3 * ( pphi(i,itroprep(i)+1)+pphis(i) ) / gravit
    2563              Z2= 1.e-3 * ( pphi(i,itroprep(i))  +pphis(i) ) / gravit
    2564              fac=(Z1-Z2)/alog(pplay(i,itroprep(i)+1)/pplay(i,itroprep(i)))
    2565              B=Z2-fac*alog(pplay(i,itroprep(i)))
    2566              ztrop(i)=fac*alog(ptrop(i))+B
     2546            Z1 = t_seri(i, itroprep(i) + 1)
     2547            Z2 = t_seri(i, itroprep(i))
     2548            fac = (Z1 - Z2) / alog(pplay(i, itroprep(i) + 1) / pplay(i, itroprep(i)))
     2549            B = Z2 - fac * alog(pplay(i, itroprep(i)))
     2550            ttrop(i) = fac * alog(ptrop(i)) + B
     2551
     2552            Z1 = 1.e-3 * (pphi(i, itroprep(i) + 1) + pphis(i)) / gravit
     2553            Z2 = 1.e-3 * (pphi(i, itroprep(i)) + pphis(i)) / gravit
     2554            fac = (Z1 - Z2) / alog(pplay(i, itroprep(i) + 1) / pplay(i, itroprep(i)))
     2555            B = Z2 - fac * alog(pplay(i, itroprep(i)))
     2556            ztrop(i) = fac * alog(ptrop(i)) + B
    25672557          ENDDO
    2568 #endif
     2558        END IF
    25692559      ELSE
    25702560        !--- ro3i = elapsed days number since current year 1st january, 0h
    … …  
    41134103    ENDIF !type_trac = inca or inco
    41144104    IF (type_trac == 'repr') THEN
    4115 #ifdef REPROBUS
    4116     !CALL chemtime_rep(itap+itau_phy-1, date0, dtime, itap)
    4117     CALL chemtime_rep(itap+itau_phy-1, date0, phys_tstep, itap)
    4118 #endif
     4105      IF (CPPKEY_REPROBUS) THEN
     4106        !CALL chemtime_rep(itap+itau_phy-1, date0, dtime, itap)
     4107        CALL chemtime_rep(itap + itau_phy - 1, date0, phys_tstep, itap)
     4108      END IF
    41194109    ENDIF
    41204110
    … …  
    51635153      !MM                               dans Reprobus
    51645154      sh_in(:, :) = q_seri(:, :)
    5165 #ifdef REPROBUS
    5166        d_q_rep(:,:) = 0.
    5167        d_ql_rep(:,:) = 0.
    5168        d_qi_rep(:,:) = 0.
    5169 #endif
     5155      IF (CPPKEY_REPROBUS) THEN
     5156        d_q_rep(:, :) = 0.
     5157        d_ql_rep(:, :) = 0.
     5158        d_qi_rep(:, :) = 0.
     5159      END IF
    51705160    ELSE
    51715161      sh_in(:, :) = qx(:, :, ivap)
    … …  
    52205210                d_tr_dyn, &                                 !<<RomP
    52215211                tr_seri, init_source)
    5222 #ifdef REPROBUS
    5223 
    5224 
    5225           PRINT*,'avt add phys rep',abortphy
    5226 
    5227      CALL add_phys_tend &
    5228             (du0,dv0,dt0,d_q_rep,d_ql_rep,d_qi_rep,dqbs0,paprs,&
    5229              'rep',abortphy,flag_inhib_tend,itap,0)
    5230         IF (abortphy==1) Print*,'ERROR ABORT REP'
    5231 
    5232           PRINT*,'apr add phys rep',abortphy
    5233 
    5234 #endif
     5212        IF (CPPKEY_REPROBUS) THEN
     5213
     5214          PRINT*, 'avt add phys rep', abortphy
     5215
     5216          CALL add_phys_tend &
     5217                  (du0, dv0, dt0, d_q_rep, d_ql_rep, d_qi_rep, dqbs0, paprs, &
     5218                  'rep', abortphy, flag_inhib_tend, itap, 0)
     5219          IF (abortphy==1) Print*, 'ERROR ABORT REP'
     5220
     5221          PRINT*, 'apr add phys rep', abortphy
     5222
     5223        END IF
    52355224      ENDIF    ! (iflag_phytrac=1)
    52365225
    … …  
    53995388
    54005389    IF (type_trac == 'repr') THEN
    5401 #ifdef REPROBUS
     5390      IF (CPPKEY_REPROBUS) THEN
    54025391        CALL coord_hyb_rep(paprs, pplay, aps, bps, ap, bp, cell_area)
    5403 #endif
     5392      END IF
    54045393    ENDIF
    54055394

  • LMDZ6/branches/Amaury_dev/libf/phylmd/radiation_AR4.f90

    r5184 r5185  
    472472  USE radiation_ar4_param, ONLY: rsun, rray
    473473  USE infotrac_phy, ONLY: type_trac
    474 #ifdef REPROBUS
    475   USE chem_rep, ONLY: rsuntime, ok_suntime
     474  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS
     475  USE lmdz_reprobus_wrappers, ONLY: rsuntime, ok_suntime
    476476  USE lmdz_print_control, ONLY: lunout
    477 #endif
    478477
    479478  IMPLICIT NONE
    … …  
    564563  ! Otherwise keep default values from radiation_AR4_param module.
    565564  IF (type_trac=='repr') THEN
    566 #ifdef REPROBUS
    567     IF (ok_suntime) THEN
    568       rsun(1) = rsuntime(1)
    569       rsun(2) = rsuntime(2)
     565    IF (CPPKEY_REPROBUS) THEN
     566      IF (ok_suntime) THEN
     567        rsun(1) = rsuntime(1)
     568        rsun(2) = rsuntime(2)
     569      END IF
     570      WRITE (lunout, *) 'RSUN(1): ', rsun(1)
    570571    END IF
    571     WRITE (lunout, *) 'RSUN(1): ', rsun(1)
    572 #endif
    573572  END IF
    574573
    … …  
    687686  USE radiation_ar4_param, ONLY: rsun, rray
    688687  USE infotrac_phy, ONLY: type_trac
    689 #ifdef REPROBUS
    690   USE chem_rep, ONLY: rsuntime, ok_suntime
    691 #endif
     688  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS
     689  USE lmdz_reprobus_wrappers, ONLY: rsuntime, ok_suntime
    692690
    693691  IMPLICIT NONE
    … …  
    811809  ! Otherwise keep default values from radiation_AR4_param module.
    812810  IF (type_trac=='repr') THEN
    813 #ifdef REPROBUS
    814     IF (ok_suntime) THEN
    815       rsun(1) = rsuntime(1)
    816       rsun(2) = rsuntime(2)
     811    IF (CPPKEY_REPROBUS) THEN
     812      IF (ok_suntime) THEN
     813        rsun(1) = rsuntime(1)
     814        rsun(2) = rsuntime(2)
     815      END IF
    817816    END IF
    818 #endif
    819817  END IF
    820818
    … …  
    22572255  USE radiation_ar4_param, ONLY: tref, rt1, raer, at, bt, oct
    22582256  USE infotrac_phy, ONLY: type_trac
    2259 #ifdef REPROBUS
    2260   USE chem_rep, ONLY: rch42d, rn2o2d, rcfc112d, rcfc122d, ok_rtime2d
    2261 #endif
     2257  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS
     2258  USE lmdz_reprobus_wrappers, ONLY: rch42d, rn2o2d, rcfc112d, rcfc122d, ok_rtime2d
    22622259  ! IM ctes ds clesphys.h
    22632260  ! REAL(KIND=8) RCO2
    … …  
    25582555
    25592556        IF (type_trac=='repr') THEN
    2560 #ifdef REPROBUS
    2561           IF (ok_rtime2d) THEN
    2562             pabcu(jl, 19, jc) = pabcu(jl, 19, jcp1) + &
    2563               zably(jl, 8, jc)*rch42d(jl, jc)/rco2*zphm6(jl)*zdiff
    2564             pabcu(jl, 20, jc) = pabcu(jl, 20, jcp1) + &
    2565               zably(jl, 9, jc)*rch42d(jl, jc)/rco2*zpsm6(jl)*zdiff
    2566             pabcu(jl, 21, jc) = pabcu(jl, 21, jcp1) + &
    2567               zably(jl, 8, jc)*rn2o2d(jl, jc)/rco2*zphn6(jl)*zdiff
    2568             pabcu(jl, 22, jc) = pabcu(jl, 22, jcp1) + &
    2569               zably(jl, 9, jc)*rn2o2d(jl, jc)/rco2*zpsn6(jl)*zdiff
    2570 
    2571             pabcu(jl, 23, jc) = pabcu(jl, 23, jcp1) + &
    2572               zably(jl, 8, jc)*rcfc112d(jl, jc)/rco2*zdiff
    2573             pabcu(jl, 24, jc) = pabcu(jl, 24, jcp1) + &
    2574               zably(jl, 8, jc)*rcfc122d(jl, jc)/rco2*zdiff
    2575           ELSE
     2557          IF (CPPKEY_REPROBUS) THEN
     2558            IF (ok_rtime2d) THEN
     2559              pabcu(jl, 19, jc) = pabcu(jl, 19, jcp1) + &
     2560                      zably(jl, 8, jc) * rch42d(jl, jc) / rco2 * zphm6(jl) * zdiff
     2561              pabcu(jl, 20, jc) = pabcu(jl, 20, jcp1) + &
     2562                      zably(jl, 9, jc) * rch42d(jl, jc) / rco2 * zpsm6(jl) * zdiff
     2563              pabcu(jl, 21, jc) = pabcu(jl, 21, jcp1) + &
     2564                      zably(jl, 8, jc) * rn2o2d(jl, jc) / rco2 * zphn6(jl) * zdiff
     2565              pabcu(jl, 22, jc) = pabcu(jl, 22, jcp1) + &
     2566                      zably(jl, 9, jc) * rn2o2d(jl, jc) / rco2 * zpsn6(jl) * zdiff
     2567
     2568              pabcu(jl, 23, jc) = pabcu(jl, 23, jcp1) + &
     2569                      zably(jl, 8, jc) * rcfc112d(jl, jc) / rco2 * zdiff
     2570              pabcu(jl, 24, jc) = pabcu(jl, 24, jcp1) + &
     2571                      zably(jl, 8, jc) * rcfc122d(jl, jc) / rco2 * zdiff
     2572            ELSE
    25762573              ! Same calculation as for type_trac /= repr
    2577             pabcu(jl, 19, jc) = pabcu(jl, 19, jcp1) + &
    2578               zably(jl, 8, jc)*rch4/rco2*zphm6(jl)*zdiff
    2579             pabcu(jl, 20, jc) = pabcu(jl, 20, jcp1) + &
    2580               zably(jl, 9, jc)*rch4/rco2*zpsm6(jl)*zdiff
    2581             pabcu(jl, 21, jc) = pabcu(jl, 21, jcp1) + &
    2582               zably(jl, 8, jc)*rn2o/rco2*zphn6(jl)*zdiff
    2583             pabcu(jl, 22, jc) = pabcu(jl, 22, jcp1) + &
    2584               zably(jl, 9, jc)*rn2o/rco2*zpsn6(jl)*zdiff
    2585 
    2586             pabcu(jl, 23, jc) = pabcu(jl, 23, jcp1) + &
    2587               zably(jl, 8, jc)*rcfc11/rco2*zdiff
    2588             pabcu(jl, 24, jc) = pabcu(jl, 24, jcp1) + &
    2589               zably(jl, 8, jc)*rcfc12/rco2*zdiff
     2574              pabcu(jl, 19, jc) = pabcu(jl, 19, jcp1) + &
     2575                      zably(jl, 8, jc) * rch4 / rco2 * zphm6(jl) * zdiff
     2576              pabcu(jl, 20, jc) = pabcu(jl, 20, jcp1) + &
     2577                      zably(jl, 9, jc) * rch4 / rco2 * zpsm6(jl) * zdiff
     2578              pabcu(jl, 21, jc) = pabcu(jl, 21, jcp1) + &
     2579                      zably(jl, 8, jc) * rn2o / rco2 * zphn6(jl) * zdiff
     2580              pabcu(jl, 22, jc) = pabcu(jl, 22, jcp1) + &
     2581                      zably(jl, 9, jc) * rn2o / rco2 * zpsn6(jl) * zdiff
     2582
     2583              pabcu(jl, 23, jc) = pabcu(jl, 23, jcp1) + &
     2584                      zably(jl, 8, jc) * rcfc11 / rco2 * zdiff
     2585              pabcu(jl, 24, jc) = pabcu(jl, 24, jcp1) + &
     2586                      zably(jl, 8, jc) * rcfc12 / rco2 * zdiff
     2587            END IF
    25902588          END IF
    2591 #endif
    25922589        ELSE
    25932590          pabcu(jl, 19, jc) = pabcu(jl, 19, jcp1) + &

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

    r5160 r5185  
    33module radlwsw_m
    44  USE lmdz_abort_physic, ONLY: abort_physic
     5  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS
    56  IMPLICIT NONE
    67
    … …  
    5455    USE lmdz_yoethf
    5556    USE lmdz_phys_constants, ONLY: dobson_u
    56 
    57 #ifdef REPROBUS
    58     USE CHEM_REP, ONLY: solaireTIME, ok_SUNTIME, ndimozon
    59 #endif
     57    USE lmdz_reprobus_wrappers, ONLY: solaireTIME, ok_SUNTIME, ndimozon
    6058
    6159#ifdef CPP_RRTM
    … …  
    560558
    561559    IF (type_trac == 'repr') THEN
    562 #ifdef REPROBUS
    563        IF (iflag_rrtm==0) THEN
    564           IF (ok_SUNTIME) PSCT = solaireTIME/zdist/zdist
    565           PRINT*,'Constante solaire: ',PSCT*zdist*zdist
    566        ENDIF
    567 #endif
     560      IF (CPPKEY_REPROBUS) THEN
     561        IF (iflag_rrtm==0) THEN
     562          IF (ok_SUNTIME) PSCT = solaireTIME / zdist / zdist
     563          PRINT*, 'Constante solaire: ', PSCT * zdist * zdist
     564        ENDIF
     565      END IF
    568566    ENDIF
    569567
    … …  
    643641
    644642      IF (type_trac == 'repr') THEN
    645 #ifdef REPROBUS
     643        IF (CPPKEY_REPROBUS) THEN
    646644          ndimozon = size(wo, 3)
    647           CALL RAD_INTERACTIF(POZON,iof)
    648 #endif
     645          CALL RAD_INTERACTIF(POZON, iof)
     646        END IF
    649647      ENDIF
    650648

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/dates.F90

    r5159 r5185  
    136136!-------------------------------------------------
    137137
    138 if(imi == 0 .and. imiv == 0) then
     138if(imi == 0 .AND. imiv == 0) then
    139139
    140140!-------------------------------------------------
    … …  
    885885ia100=100*(iaaaa/100)
    886886ia4=4*(iaaaa/4)
    887 if((iaaaa == ia400).or.((iaaaa == ia4).and.(iaaaa /= ia100)))then
     887if((iaaaa == ia400).or.((iaaaa == ia4).AND.(iaaaa /= ia100)))then
    888888  ibissext=1
    889889else
    890890  ibissext=0
    891891endif
    892 if ((ibissext == 1).and.(imm > 2)) then
     892if ((ibissext == 1).AND.(imm > 2)) then
    893893  ijourp=1
    894894else
    … …  
    924924ia100=100*(iaaaa/100)
    925925ia4=4*(iaaaa/4)
    926 if((iaaaa == ia400).or.((iaaaa == ia4).and.(iaaaa /= ia100)))then
     926if((iaaaa == ia400).or.((iaaaa == ia4).AND.(iaaaa /= ia100)))then
    927927  ibissext=1
    928928else
    929929  ibissext=0
    930930endif
    931 if ((ibissext == 1).and.(imm > 2)) then
     931if ((ibissext == 1).AND.(imm > 2)) then
    932932  ijourp=1
    933933else
    … …  
    10501050ia100=100*(iaaaa/100)
    10511051ia4=4*(iaaaa/4)
    1052 if((iaaaa == ia400).or.((iaaaa == ia4).and.(iaaaa /= ia100)))then
     1052if((iaaaa == ia400).or.((iaaaa == ia4).AND.(iaaaa /= ia100)))then
    10531053  ibissext=1
    10541054else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/dump2ds.F

    r5133 r5185  
    88c NAN et INF ajoute aux plots                           Pat fin 2006
    99c ==================================================================
    10 c Comme dump2d sauf que le signe est préservé, la valeur zero
     10c Comme dump2d sauf que le signe est pr�serv�, la valeur zero
    1111c identifiee par un blanc.
    1212c detection des Infty (= ou -) et NaN (?)
    … …  
    7979      kchar(i)=16
    8080      GOTO 10022
    81 10021 IF(.NOT.((az.ne.0.and.icheck(1).eq.0.and.icheck(2).eq.2146435072))
     8110021 IF(.NOT.((az.ne.0.AND.icheck(1).eq.0.AND.icheck(2).eq.2146435072))
    8282     *)GOTO 10023
    8383      kchar(i)=31
    8484      zinf=.true.
    8585      GOTO 10022
    86 10023 IF(.NOT.((az.ne.0.and.icheck(1).eq.0.and.icheck(2).eq.2146959360))
     8610023 IF(.NOT.((az.ne.0.AND.icheck(1).eq.0.AND.icheck(2).eq.2146959360))
    8787     *)GOTO 10024
    8888      kchar(i)=32

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/eq_regions_mod.F90

    r5159 r5185  
    170170integer(kind=jpim) :: num_c
    171171logical enough
    172 enough = (N > 2) .and. (a_ideal > 0)
     172enough = (N > 2) .AND. (a_ideal > 0)
    173173if( enough )then
    174174  num_c = max(1,nint((pi-2.*c_polar)/a_ideal))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/lwu.F90

    r5160 r5185  
    1 
    21! $Id$
    32
    … …  
    7473  !USE YOERDI   , ONLY : RCH4     ,RN2O     ,RCFC11   ,RCFC12
    7574  USE YOERDU, ONLY: R10E, REPSCO, REPSCQ
    76 #ifdef REPROBUS
    77 USE chem_rep, ONLY: rch42d, rn2o2d, rcfc112d, rcfc122d, ok_rtime2d
    78 USE infotrac_phy, ONLY : type_trac
    79 #endif
     75  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS
     76  USE lmdz_reprobus_wrappers, ONLY: rch42d, rn2o2d, rcfc112d, rcfc122d, ok_rtime2d
     77  USE infotrac_phy, ONLY: type_trac
    8078  USE lmdz_clesphys
    8179
    … …  
    319317        PABCU(JL, 17, IC) = PABCU(JL, 17, ICP1) + ZUAER(JL, 4) * ZDUC(JL, IC) * ZDIFF
    320318        PABCU(JL, 18, IC) = PABCU(JL, 18, ICP1) + ZUAER(JL, 5) * ZDUC(JL, IC) * ZDIFF
    321 #ifdef REPROBUS
    322         IF (type_trac=='repr'.and. ok_rtime2d) THEN
    323 !- CH4
    324       PABCU(JL,19,IC)=PABCU(JL,19,ICP1)&
    325        & + ZABLY(JL,2,IC)*RCH42D(JL, IC)/PCCO2*ZPHM6(JL)*ZDIFF
    326       PABCU(JL,20,IC)=PABCU(JL,20,ICP1)&
    327        & + ZABLY(JL,3,IC)*RCH42D(JL, IC)/PCCO2*ZPSM6(JL)*ZDIFF
    328 !- N2O
    329       PABCU(JL,21,IC)=PABCU(JL,21,ICP1)&
    330        & + ZABLY(JL,2,IC)*RN2O2D(JL, IC)/PCCO2*ZPHN6(JL)*ZDIFF
    331       PABCU(JL,22,IC)=PABCU(JL,22,ICP1)&
    332        & + ZABLY(JL,3,IC)*RN2O2D(JL, IC)/PCCO2*ZPSN6(JL)*ZDIFF
    333 !- CFC11
    334       PABCU(JL,23,IC)=PABCU(JL,23,ICP1)&
    335        & + ZABLY(JL,2,IC)*RCFC112D(JL, IC)/PCCO2        *ZDIFF
    336 !- CFC12
    337       PABCU(JL,24,IC)=PABCU(JL,24,ICP1)&
    338        & + ZABLY(JL,2,IC)*RCFC122D(JL, IC)/PCCO2        *ZDIFF
    339 
    340          ELSE
    341 #endif
    342         !- CH4
    343         PABCU(JL, 19, IC) = PABCU(JL, 19, ICP1)&
    344                 & + ZABLY(JL, 2, IC) * RCH4 / PCCO2 * ZPHM6(JL) * ZDIFF
    345         PABCU(JL, 20, IC) = PABCU(JL, 20, ICP1)&
    346                 & + ZABLY(JL, 3, IC) * RCH4 / PCCO2 * ZPSM6(JL) * ZDIFF
    347         !- N2O
    348         PABCU(JL, 21, IC) = PABCU(JL, 21, ICP1)&
    349                 & + ZABLY(JL, 2, IC) * RN2O / PCCO2 * ZPHN6(JL) * ZDIFF
    350         PABCU(JL, 22, IC) = PABCU(JL, 22, ICP1)&
    351                 & + ZABLY(JL, 3, IC) * RN2O / PCCO2 * ZPSN6(JL) * ZDIFF
    352         !- CFC11
    353         PABCU(JL, 23, IC) = PABCU(JL, 23, ICP1)&
    354                 & + ZABLY(JL, 2, IC) * RCFC11 / PCCO2 * ZDIFF
    355         !- CFC12
    356         PABCU(JL, 24, IC) = PABCU(JL, 24, ICP1)&
    357                 & + ZABLY(JL, 2, IC) * RCFC12 / PCCO2 * ZDIFF
    358 #ifdef REPROBUS
     319        IF (CPPKEY_REPROBUS .AND. type_trac=='repr'.AND. ok_rtime2d) THEN
     320          !- CH4
     321          PABCU(JL, 19, IC) = PABCU(JL, 19, ICP1)&
     322                  & + ZABLY(JL, 2, IC) * RCH42D(JL, IC) / PCCO2 * ZPHM6(JL) * ZDIFF
     323          PABCU(JL, 20, IC) = PABCU(JL, 20, ICP1)&
     324                  & + ZABLY(JL, 3, IC) * RCH42D(JL, IC) / PCCO2 * ZPSM6(JL) * ZDIFF
     325          !- N2O
     326          PABCU(JL, 21, IC) = PABCU(JL, 21, ICP1)&
     327                  & + ZABLY(JL, 2, IC) * RN2O2D(JL, IC) / PCCO2 * ZPHN6(JL) * ZDIFF
     328          PABCU(JL, 22, IC) = PABCU(JL, 22, ICP1)&
     329                  & + ZABLY(JL, 3, IC) * RN2O2D(JL, IC) / PCCO2 * ZPSN6(JL) * ZDIFF
     330          !- CFC11
     331          PABCU(JL, 23, IC) = PABCU(JL, 23, ICP1)&
     332                  & + ZABLY(JL, 2, IC) * RCFC112D(JL, IC) / PCCO2 * ZDIFF
     333          !- CFC12
     334          PABCU(JL, 24, IC) = PABCU(JL, 24, ICP1)&
     335                  & + ZABLY(JL, 2, IC) * RCFC122D(JL, IC) / PCCO2 * ZDIFF
     336
     337        ELSE
     338          !- CH4
     339          PABCU(JL, 19, IC) = PABCU(JL, 19, ICP1)&
     340                  & + ZABLY(JL, 2, IC) * RCH4 / PCCO2 * ZPHM6(JL) * ZDIFF
     341          PABCU(JL, 20, IC) = PABCU(JL, 20, ICP1)&
     342                  & + ZABLY(JL, 3, IC) * RCH4 / PCCO2 * ZPSM6(JL) * ZDIFF
     343          !- N2O
     344          PABCU(JL, 21, IC) = PABCU(JL, 21, ICP1)&
     345                  & + ZABLY(JL, 2, IC) * RN2O / PCCO2 * ZPHN6(JL) * ZDIFF
     346          PABCU(JL, 22, IC) = PABCU(JL, 22, ICP1)&
     347                  & + ZABLY(JL, 3, IC) * RN2O / PCCO2 * ZPSN6(JL) * ZDIFF
     348          !- CFC11
     349          PABCU(JL, 23, IC) = PABCU(JL, 23, ICP1)&
     350                  & + ZABLY(JL, 2, IC) * RCFC11 / PCCO2 * ZDIFF
     351          !- CFC12
     352          PABCU(JL, 24, IC) = PABCU(JL, 24, ICP1)&
     353                  & + ZABLY(JL, 2, IC) * RCFC12 / PCCO2 * ZDIFF
    359354        END IF
    360 #endif
    361355      ENDDO
    362356    ENDDO

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/recmwf_aero.F90

    r5159 r5185  
    592592
    593593     !--Case 4
    594      IF (ok_ade .and. ok_aie) THEN
     594     IF (ok_ade .AND. ok_aie) THEN
    595595
    596596        ! total aerosols for direct indirect effect
    … …  
    628628        LWDN_AERO(:,:,4) = PFLUX(:,2,:)
    629629
    630      ENDIF ! ok_ade .and. ok_aie
     630     ENDIF ! ok_ade .AND. ok_aie
    631631
    632632  ENDIF !--if flag_aerosol GT 0 OR flag_aerosol_strat
    … …  
    734734  IF  ( AEROSOLFEEDBACK_ACTIVE .AND. (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) ) THEN
    735735
    736      IF ( ok_ade .and. ok_aie  ) THEN
     736     IF ( ok_ade .AND. ok_aie  ) THEN
    737737        PFSUP(:,:) =    ZFSUP_AERO(:,:,4)
    738738        PFSDN(:,:) =    ZFSDN_AERO(:,:,4)
    … …  
    746746     ENDIF
    747747
    748      IF ( ok_ade .and. (.not. ok_aie) )  THEN
     748     IF ( ok_ade .AND. (.not. ok_aie) )  THEN
    749749        PFSUP(:,:) =    ZFSUP_AERO(:,:,3)
    750750        PFSDN(:,:) =    ZFSDN_AERO(:,:,3)
    … …  
    758758     ENDIF
    759759
    760      IF ( (.not. ok_ade) .and. ok_aie  )  THEN
     760     IF ( (.not. ok_ade) .AND. ok_aie  )  THEN
    761761        PFSUP(:,:) =    ZFSUP_AERO(:,:,2)
    762762        PFSDN(:,:) =    ZFSDN_AERO(:,:,2)
    … …  
    770770     ENDiF
    771771
    772      IF ((.not. ok_ade) .and. (.not. ok_aie)) THEN
     772     IF ((.not. ok_ade) .AND. (.not. ok_aie)) THEN
    773773        PFSUP(:,:) =    ZFSUP_AERO(:,:,1)
    774774        PFSDN(:,:) =    ZFSDN_AERO(:,:,1)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_rtrn1a_140gp.F90

    r5160 r5185  
    383383!       & (1.0_JPRB - Z_CLDFRAC(I_LEV-1))   
    384384!    ENDIF
    385      if(istcld(i_lev).ne.1.and.i_lev.ne.1) then
     385     if(istcld(i_lev).ne.1.AND.i_lev.ne.1) then
    386386        z_faccmb1(i_lev+1) = max(0.,min(z_cldfrac(i_lev+1)-z_cldfrac(i_lev), &
    387387               z_cldfrac(i_lev-1)-z_cldfrac(i_lev)))
    … …  
    496496!    Z_FACCMB2D(I_LEV-1) = Z_FACCLD1D(I_LEV-1) * Z_FACCLR2D(I_LEV) *&
    497497!     & (1.0_JPRB - Z_CLDFRAC(I_LEV+1)) 
    498     if (istcldd(i_lev).ne.1.and.i_lev.ne.1) then
     498    if (istcldd(i_lev).ne.1.AND.i_lev.ne.1) then
    499499       z_faccmb1d(i_lev-1) = max(0.,min(z_cldfrac(i_lev+1)-z_cldfrac(i_lev), &
    500500                            z_cldfrac(i_lev-1)-z_cldfrac(i_lev)))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/tracreprobus_mod.f90

    r5184 r5185  
    11MODULE tracreprobus_mod
    22
    3 ! This module prepares and calls the Reprobus main SUBROUTINE
     3  ! This module prepares and calls the Reprobus main SUBROUTINE
    44
    55CONTAINS
    66
    77  SUBROUTINE tracreprobus(pdtphys, gmtime, debutphy, julien, &
    8        presnivs, xlat, xlon, pphis, pphi, &
    9        t_seri, pplay, paprs, sh , &
    10        tr_seri)
     8          presnivs, xlat, xlon, pphis, pphi, &
     9          t_seri, pplay, paprs, sh, &
     10          tr_seri)
    1111
    1212    USE dimphy
    1313    USE infotrac_phy, ONLY: nbtr
    14 #ifdef REPROBUS
    15     USE CHEM_REP, ONLY: pdt_rep, &  ! pas de temps reprobus
    16          daynum, iter, &             ! jourjulien, iteration chimie
    17          pdel,&
    18          d_q_rep,d_ql_rep,d_qi_rep
    19 #endif
     14    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS
     15    USE lmdz_reprobus_wrappers, ONLY: pdt_rep, &  ! pas de temps reprobus
     16            daynum, iter, &             ! jourjulien, iteration chimie
     17            pdel, &
     18            d_q_rep, d_ql_rep, d_qi_rep
    2019    IMPLICIT NONE
    2120
    22 ! Input argument
    23 !---------------
    24     REAL,INTENT(IN)    :: pdtphys    ! Pas d'integration pour la physique (seconde)
    25     REAL,INTENT(IN)    :: gmtime     ! Heure courante
    26     LOGICAL,INTENT(IN) :: debutphy   ! le flag de l'initialisation de la physique
    27     INTEGER,INTENT(IN) :: julien     ! Jour julien
     21    ! Input argument
     22    !---------------
     23    REAL, INTENT(IN) :: pdtphys    ! Pas d'integration pour la physique (seconde)
     24    REAL, INTENT(IN) :: gmtime     ! Heure courante
     25    LOGICAL, INTENT(IN) :: debutphy   ! le flag de l'initialisation de la physique
     26    INTEGER, INTENT(IN) :: julien     ! Jour julien
    2827
    29     REAL,DIMENSION(klev),INTENT(IN)        :: presnivs! pressions approximat. des milieux couches (en PA)
    30     REAL,DIMENSION(klon),INTENT(IN)        :: xlat    ! latitudes pour chaque point
    31     REAL,DIMENSION(klon),INTENT(IN)        :: xlon    ! longitudes pour chaque point
    32     REAL,DIMENSION(klon),INTENT(IN)        :: pphis   ! geopotentiel du sol
    33     REAL,DIMENSION(klon,klev),INTENT(IN)  :: pphi    ! geopotentiel de chaque couche
     28    REAL, DIMENSION(klev), INTENT(IN) :: presnivs! pressions approximat. des milieux couches (en PA)
     29    REAL, DIMENSION(klon), INTENT(IN) :: xlat    ! latitudes pour chaque point
     30    REAL, DIMENSION(klon), INTENT(IN) :: xlon    ! longitudes pour chaque point
     31    REAL, DIMENSION(klon), INTENT(IN) :: pphis   ! geopotentiel du sol
     32    REAL, DIMENSION(klon, klev), INTENT(IN) :: pphi    ! geopotentiel de chaque couche
    3433
    35     REAL,DIMENSION(klon,klev),INTENT(IN)  :: t_seri  ! Temperature
    36     REAL,DIMENSION(klon,klev),INTENT(IN)  :: pplay   ! pression pour le mileu de chaque couche (en Pa)
    37     REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs   ! pression pour chaque inter-couche (en Pa)
    38     REAL,DIMENSION(klon,klev),INTENT(IN)   :: sh      ! humidite specifique   
     34    REAL, DIMENSION(klon, klev), INTENT(IN) :: t_seri  ! Temperature
     35    REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay   ! pression pour le mileu de chaque couche (en Pa)
     36    REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs   ! pression pour chaque inter-couche (en Pa)
     37    REAL, DIMENSION(klon, klev), INTENT(IN) :: sh      ! humidite specifique
    3938
    4039
    41 ! Output argument
    42 !----------------
    43     REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT)  :: tr_seri ! Concentration Traceur [U/KgA] 
    44  
     40    ! Output argument
     41    !----------------
     42    REAL, DIMENSION(klon, klev, nbtr), INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA]
    4543
    46 ! Local variables
    47 !----------------
     44
     45    ! Local variables
     46    !----------------
    4847    INTEGER :: it, k, niter
    4948
    50 #ifdef REPROBUS
    51     !   -- CHIMIE REPROBUS --
    52 !    pdt_rep=pdtphys/2.
    53     niter=pdtphys/pdt_rep
    54     WRITE(*,*)'nb d appel de REPROBUS',niter
    55    
    56     DO k = 1, klev
    57        pdel(:,k) = paprs(:,k) - paprs (:,k+1)
    58     END DO
    59    
    60     ! initialisation de ozone passif a ozone en debut d hiver HN et HS
    61     IF (julien == 341 .OR. julien == 181) THEN
    62        tr_seri(:,:,11)=tr_seri(:,:,8)
     49    IF (CPPKEY_REPROBUS) THEN
     50      !   -- CHIMIE REPROBUS --
     51      !    pdt_rep=pdtphys/2.
     52      niter = pdtphys / pdt_rep
     53      WRITE(*, *)'nb d appel de REPROBUS', niter
     54
     55      DO k = 1, klev
     56        pdel(:, k) = paprs(:, k) - paprs (:, k + 1)
     57      END DO
     58
     59      ! initialisation de ozone passif a ozone en debut d hiver HN et HS
     60      IF (julien == 341 .OR. julien == 181) THEN
     61        tr_seri(:, :, 11) = tr_seri(:, :, 8)
     62      END IF
     63
     64      d_q_rep(:, :) = 0.
     65      d_ql_rep(:, :) = 0.
     66      d_qi_rep(:, :) = 0.
     67
     68      DO  iter = 1, niter
     69        daynum = FLOAT(julien) + gmtime + (iter - 1) * pdt_rep / 86400.
     70
     71        !       DO it=1, nbtr
     72        !     WRITE(lunout,*)it,' ',minval(tr_seri(:,:,it)),maxval(tr_seri(:,:,it))
     73        ! seulement pour les especes chimiques (pas l'age de l'air)
     74        ! verif valeurs extremes
     75        ! correction: a 1.e-30 quand =0 ou negatif et
     76        ! CALL abort si >ou= 1.e10
     77        !          WRITE(*,*)it,'nqtot',nqtot,'nbtr',nbtr
     78        !          IF (it < nqtot) THEN
     79        !             WRITE(*,*)'iciav',it,nqtot
     80        !             CALL minmaxqfi_chimie(it,tr_seri(1,1,it),0.,1.e10,'avant chimie ')
     81        !             WRITE(*,*)iter,'avpres'
     82        !          ENDIF
     83        !       ENDDO
     84
     85        CALL chemmain_rlong_1401(&
     86                tr_seri, & !argument phytrac (change de nom apres: vmr)
     87                xlon, & !argument phytrac (change de nom apres: lon)
     88                xlat, & !argument phytrac (change de nom apres: lat)
     89                t_seri, & !argument phytrac (meme nom)
     90                pplay, & !argument phytrac (meme nom)
     91                paprs, &
     92                pphi, & !argument phytrac (meme nom)
     93                pphis, & !argument phytrac (meme nom)
     94                presnivs, & !argument phytrac (meme nom)
     95                sh, & !argument phytrac (meme nom)
     96                debutphy) !argument phytrac (change de nom apres: debut)
     97        ! pdel, pdt_rep, daynum : definit dans phytrac et utilise dans chemmain
     98        !                 et transporte par CHEM_REP
     99
     100        !       DO it=1, nbtr
     101        !     WRITE(lunout,*)it,' ',minval(tr_seri(:,:,it)),maxval(tr_seri(:,:,it))
     102        ! seulement pour les especes chimiques (pas l'age de l'air)
     103        ! verif valeurs extremes
     104        ! correction: a 1.e-30 quand =0 ou negatif et
     105        ! CALL abort si >ou= 1.e10
     106        !          WRITE(*,*)it,'nqtot',nqtot,'nbtr',nbtr
     107        !          IF (it < nqtot) THEN
     108        !             WRITE(*,*)'iciap',it,nqtot
     109        !             CALL minmaxqfi_chimie(it,tr_seri(1,1,it),0.,1.e10,'apres chemmain')
     110        !             WRITE(*,*)iter,'appres'
     111        !          ENDIF
     112        !       ENDDO
     113
     114      END DO
    63115    END IF
    64 
    65     d_q_rep(:,:)  =0.
    66     d_ql_rep(:,:) =0.
    67     d_qi_rep(:,:) =0.
    68    
    69     DO  iter = 1,niter
    70        daynum = FLOAT(julien) + gmtime + (iter-1)*pdt_rep/86400.
    71        
    72 !       DO it=1, nbtr
    73 !     WRITE(lunout,*)it,' ',minval(tr_seri(:,:,it)),maxval(tr_seri(:,:,it))
    74 ! seulement pour les especes chimiques (pas l'age de l'air)
    75 ! verif valeurs extremes
    76 ! correction: a 1.e-30 quand =0 ou negatif et
    77 ! CALL abort si >ou= 1.e10
    78 !          WRITE(*,*)it,'nqtot',nqtot,'nbtr',nbtr
    79 !          IF (it < nqtot) THEN
    80 !             WRITE(*,*)'iciav',it,nqtot
    81 !#ifdef REPROBUS
    82 !             CALL minmaxqfi_chimie(it,tr_seri(1,1,it),0.,1.e10,'avant chimie ')
    83 !#endif
    84 !             WRITE(*,*)iter,'avpres'
    85 !          ENDIF
    86 !       ENDDO
    87        
    88 #ifdef REPROBUS
    89        CALL chemmain_rlong_1401( &
    90             tr_seri, & !argument phytrac (change de nom apres: vmr)
    91             xlon,    & !argument phytrac (change de nom apres: lon)
    92             xlat,    & !argument phytrac (change de nom apres: lat)
    93             t_seri,  & !argument phytrac (meme nom)
    94             pplay,   & !argument phytrac (meme nom)
    95             paprs,   &
    96             pphi,    & !argument phytrac (meme nom)
    97             pphis,   & !argument phytrac (meme nom)
    98             presnivs, & !argument phytrac (meme nom)
    99             sh,      & !argument phytrac (meme nom)
    100             debutphy) !argument phytrac (change de nom apres: debut)
    101        ! pdel, pdt_rep, daynum : definit dans phytrac et utilise dans chemmain
    102        !                 et transporte par CHEM_REP
    103 
    104 !       DO it=1, nbtr
    105 !     WRITE(lunout,*)it,' ',minval(tr_seri(:,:,it)),maxval(tr_seri(:,:,it))
    106 ! seulement pour les especes chimiques (pas l'age de l'air)
    107 ! verif valeurs extremes
    108 ! correction: a 1.e-30 quand =0 ou negatif et
    109 ! CALL abort si >ou= 1.e10
    110 !          WRITE(*,*)it,'nqtot',nqtot,'nbtr',nbtr
    111 !          IF (it < nqtot) THEN
    112 !             WRITE(*,*)'iciap',it,nqtot
    113 !             CALL minmaxqfi_chimie(it,tr_seri(1,1,it),0.,1.e10,'apres chemmain')
    114 !             WRITE(*,*)iter,'appres'
    115 !          ENDIF
    116 !       ENDDO
    117 
    118 #endif       
    119        
    120     END DO
    121 #endif
    122116  END SUBROUTINE tracreprobus
    123117

  • LMDZ6/branches/Amaury_dev/libf/phylmd/tropopause_m.f90

    r5184 r5185  
    11MODULE tropopause_m
    22
    3   IMPLICIT NONE
    4   PRIVATE
    5   PUBLIC :: dyn_tropopause
     3  IMPLICIT NONE; PRIVATE
     4  PUBLIC dyn_tropopause
    65
    76CONTAINS
    … …  
    1716    USE lmdz_geometry, ONLY: latitude_deg, longitude_deg
    1817    USE lmdz_vertical_layers, ONLY: aps, bps, preff
    19 #ifdef REPROBUS
    20   USE chem_rep, ONLY: itroprep
    21 #endif
     18    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS
     19    USE lmdz_reprobus_wrappers, ONLY: itroprep
    2220    USE lmdz_yomcst
    2321
    … …  
    116114        END DO; kp = kt
    117115      END IF
    118 #ifdef REPROBUS
    119     itroprep(i)=MAX(kt,kp)
    120 #endif
     116      IF (CPPKEY_REPROBUS) THEN
     117        itroprep(i) = MAX(kt, kp)
     118      END IF
    121119      !--- LAST TROPOSPHERIC LAYER INDEX NEEDED
    122120      IF(PRESENT(itrop)) itrop(i) = MAX(kt, kp)

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

    r5173 r5185  
    116116    USE lmdz_calcul_divers, ONLY: calcul_divers
    117117
    118     USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DUST, CPPKEY_STRATAER, CPPKEY_COSP, CPPKEY_COSP2, CPPKEY_COSPV2
     118    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DUST, CPPKEY_STRATAER, CPPKEY_COSP, CPPKEY_COSP2, CPPKEY_COSPV2, &
     119            CPPKEY_REPROBUS
    119120
    120121!!!!!!!!!!!!!!!!!! "USE" section for CPP keys !!!!!!!!!!!!!!!!!!!!!!!!
    121122
    122123
    123 #ifdef REPROBUS
    124     USE chem_rep, ONLY: Init_chem_rep_xjour, d_q_rep, d_ql_rep, d_qi_rep, &
     124    USE lmdz_reprobus_wrappers, ONLY: Init_chem_rep_xjour, d_q_rep, d_ql_rep, d_qi_rep, &
    125125                        ptrop, ttrop, ztrop, gravit, itroprep, Z1, Z2, fac, B
    126126    USE strataer_local_var_mod
    127127    USE strataer_emiss_mod, ONLY: strataer_emiss_init
    128 #endif
    129128
    130129#ifdef CPP_RRTM
    … …  
    14821481          CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
    14831482
    1484 #ifdef REPROBUS
    1485        CALL strataer_init
    1486        CALL strataer_emiss_init
    1487 #endif
     1483       IF (CPPKEY_REPROBUS) THEN
     1484         CALL strataer_init
     1485         CALL strataer_emiss_init
     1486       END IF
    14881487
    14891488IF (CPPKEY_STRATAER) THEN
    … …  
    23732372
    23742373       IF (type_trac == 'repr') THEN
    2375 #ifdef REPROBUS
    2376           CALL chemini_rep(  &
    2377                presnivs, &
    2378                pdtphys, &
    2379                annee_ref, &
    2380                day_ref, &
    2381                day_ini, &
    2382                start_time, &
    2383                itau_phy, &
    2384                io_lon, &
    2385                io_lat)
    2386 #endif
     2374         IF (CPPKEY_REPROBUS) THEN
     2375           CALL chemini_rep(&
     2376                   presnivs, &
     2377                   pdtphys, &
     2378                   annee_ref, &
     2379                   day_ref, &
     2380                   day_ini, &
     2381                   start_time, &
     2382                   itau_phy, &
     2383                   io_lon, &
     2384                   io_lat)
     2385         END IF
    23872386       ENDIF
    23882387
    … …  
    24902489    ! Update time and other variables in Reprobus
    24912490    IF (type_trac == 'repr') THEN
    2492 #ifdef REPROBUS
    2493        CALL Init_chem_rep_xjour(jD_cur-jD_ref+day_ref)
    2494        PRINT*,'xjour equivalent rjourvrai',jD_cur-jD_ref+day_ref
    2495        CALL Rtime(debut)
    2496 #endif
     2491      IF (CPPKEY_REPROBUS) THEN
     2492        CALL Init_chem_rep_xjour(jD_cur - jD_ref + day_ref)
     2493        PRINT*, 'xjour equivalent rjourvrai', jD_cur - jD_ref + day_ref
     2494        CALL Rtime(debut)
     2495      END IF
    24972496    ENDIF
    24982497
    … …  
    29362935
    29372936          wo(:,:,1)=ozonecm(latitude_deg, paprs,read_climoz,rjour=zzz)
    2938 #ifdef REPROBUS
    2939           ptrop=dyn_tropopause(t_seri, ztsol, paprs, pplay, rot)/100.
    2940           DO i = 1, klon
    2941              Z1=t_seri(i,itroprep(i)+1)
    2942              Z2=t_seri(i,itroprep(i))
    2943              fac=(Z1-Z2)/alog(pplay(i,itroprep(i)+1)/pplay(i,itroprep(i)))
    2944              B=Z2-fac*alog(pplay(i,itroprep(i)))
    2945              ttrop(i)= fac*alog(ptrop(i))+B
    2946 
    2947              Z1= 1.e-3 * ( pphi(i,itroprep(i)+1)+pphis(i) ) / gravit
    2948              Z2= 1.e-3 * ( pphi(i,itroprep(i))  +pphis(i) ) / gravit
    2949              fac=(Z1-Z2)/alog(pplay(i,itroprep(i)+1)/pplay(i,itroprep(i)))
    2950              B=Z2-fac*alog(pplay(i,itroprep(i)))
    2951              ztrop(i)=fac*alog(ptrop(i))+B
    2952           ENDDO
    2953 #endif
     2937          IF (CPPKEY_REPROBUS) THEN
     2938            ptrop = dyn_tropopause(t_seri, ztsol, paprs, pplay, rot) / 100.
     2939            DO i = 1, klon
     2940              Z1 = t_seri(i, itroprep(i) + 1)
     2941              Z2 = t_seri(i, itroprep(i))
     2942              fac = (Z1 - Z2) / alog(pplay(i, itroprep(i) + 1) / pplay(i, itroprep(i)))
     2943              B = Z2 - fac * alog(pplay(i, itroprep(i)))
     2944              ttrop(i) = fac * alog(ptrop(i)) + B
     2945
     2946              Z1 = 1.e-3 * (pphi(i, itroprep(i) + 1) + pphis(i)) / gravit
     2947              Z2 = 1.e-3 * (pphi(i, itroprep(i)) + pphis(i)) / gravit
     2948              fac = (Z1 - Z2) / alog(pplay(i, itroprep(i) + 1) / pplay(i, itroprep(i)))
     2949              B = Z2 - fac * alog(pplay(i, itroprep(i)))
     2950              ztrop(i) = fac * alog(ptrop(i)) + B
     2951            ENDDO
     2952          END IF
    29542953       ELSE
    29552954          !--- ro3i = elapsed days number since current year 1st january, 0h
    … …  
    56025601    ENDIF !type_trac = inca or inco
    56035602    IF (type_trac == 'repr') THEN
    5604 #ifdef REPROBUS
    5605     !CALL chemtime_rep(itap+itau_phy-1, date0, dtime, itap)
    5606     CALL chemtime_rep(itap+itau_phy-1, date0, phys_tstep, itap)
    5607 #endif
     5603      IF (CPPKEY_REPROBUS) THEN
     5604        !CALL chemtime_rep(itap+itau_phy-1, date0, dtime, itap)
     5605        CALL chemtime_rep(itap + itau_phy - 1, date0, phys_tstep, itap)
     5606      END IF
    56085607    ENDIF
    56095608
    … …  
    67886787!MM                               dans Reprobus
    67896788       sh_in(:,:) = q_seri(:,:)
    6790 #ifdef REPROBUS
    6791        d_q_rep(:,:) = 0.
    6792        d_ql_rep(:,:) = 0.
    6793        d_qi_rep(:,:) = 0.
    6794 #endif
     6789       IF (CPPKEY_REPROBUS) THEN
     6790         d_q_rep(:, :) = 0.
     6791         d_ql_rep(:, :) = 0.
     6792         d_qi_rep(:, :) = 0.
     6793       END IF
    67956794    ELSE
    67966795       sh_in(:,:) = qx(:,:,ivap)
    … …  
    68456844         d_tr_dyn, &                                 !<<RomP
    68466845         tr_seri, init_source)
    6847 #ifdef REPROBUS
    6848 
    6849 
    6850           PRINT*,'avt add phys rep',abortphy
    6851 
    6852      CALL add_phys_tend &
    6853             (du0,dv0,dt0,d_q_rep,d_ql_rep,d_qi_rep,dqbs0,paprs,&
    6854              'rep',abortphy,flag_inhib_tend,itap,0)
    6855         IF (abortphy==1) Print*,'ERROR ABORT REP'
    6856 
    6857           PRINT*,'apr add phys rep',abortphy
    6858 
    6859 #endif
     6846      IF (CPPKEY_REPROBUS) THEN
     6847#ifdef ISO
     6848        CALL abort_gcm("physiq_mod", "StratAer isn't ISO-compatible for now, 07/24",1)
     6849#else
     6850
     6851        PRINT*, 'avt add phys rep', abortphy
     6852
     6853        CALL add_phys_tend &
     6854                (du0, dv0, dt0, d_q_rep, d_ql_rep, d_qi_rep, dqbs0, paprs, &
     6855                'rep', abortphy, flag_inhib_tend, itap, 0)
     6856        IF (abortphy==1) Print*, 'ERROR ABORT REP'
     6857
     6858        PRINT*, 'apr add phys rep', abortphy
     6859#endif
     6860      END IF
     6861
    68606862    ENDIF    ! (iflag_phytrac=1)
    68616863
    … …  
    70367038
    70377039    IF (type_trac == 'repr') THEN
    7038 #ifdef REPROBUS
     7040      IF (CPPKEY_REPROBUS) THEN
    70397041        CALL coord_hyb_rep(paprs, pplay, aps, bps, ap, bp, cell_area)
    7040 #endif
     7042      END IF
    70417043    ENDIF
    70427044

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/radiation_AR4.f90

    r5184 r5185  
    1 link ../phylmd/radiation_AR4.F90
     1link ../phylmd/radiation_AR4.f90

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/tracreprobus_mod.f90

    r5184 r5185  
    1 link ../phylmd/tracreprobus_mod.F90
     1link ../phylmd/tracreprobus_mod.f90

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/tropopause_m.f90

    r5184 r5185  
    1 link ../phylmd/tropopause_m.F90
     1link ../phylmd/tropopause_m.f90
Note: See TracChangeset for help on using the changeset viewer.