Ignore:
Timestamp:
Jul 24, 2024, 4:23:34 PM (2 months ago)
Author:
abarral
Message:

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

Location:
LMDZ6/branches/Amaury_dev/libf/dyn3d
Files:
28 edited

Legend:

Unmodified
Added
Removed

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

    r5116 r5117  
    77  USE IOIPSL
    88  !! ug Pour les sorties XIOS
    9   USE wxios
     9  USE lmdz_wxios
    1010
    1111  include "iniprint.h"
    … …  
    1919  !     ierr    = severity of situation ( = 0 normal )
    2020
    21   CHARACTER(LEN = *), intent(in) :: modname
    22   integer, intent(in) :: ierr
    23   CHARACTER(LEN = *), intent(in) :: message
     21  CHARACTER(LEN = *), INTENT(IN) :: modname
     22  INTEGER, INTENT(IN) :: ierr
     23  CHARACTER(LEN = *), INTENT(IN) :: message
    2424
    2525  WRITE(lunout, *) 'in abort_gcm'
    … …  
    3535  WRITE(lunout, *) 'Stopping in ', modname
    3636  WRITE(lunout, *) 'Reason = ', message
    37   if (ierr == 0) THEN
     37  IF (ierr == 0) THEN
    3838    WRITE(lunout, *) 'Everything is cool'
    3939    stop
    … …  
    4141    WRITE(lunout, *) 'Houston, we have a problem, ierr = ', ierr
    4242    stop 1
    43   endif
     43  ENDIF
    4444END SUBROUTINE abort_gcm

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

    r5116 r5117  
    119119  ENDDO
    120120
    121   if (planet_type=="earth") THEN
     121  IF (planet_type=="earth") THEN
    122122    ! earth case, special treatment for first 2 tracers (water)
    123123    DO iq = 1, 2
    … …  
    148148      ENDDO
    149149    ENDDO
    150   endif ! of if (planet_type=="earth")
     150  ENDIF ! of if (planet_type=="earth")
    151151
    152152  DO  ij = 1, iim

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

    r5116 r5117  
    1313  USE comconst_mod, ONLY: dtvr
    1414  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
    15   USE strings_mod, ONLY: int2str
     15  USE lmdz_strings, ONLY: int2str
    1616  USE lmdz_description, ONLY: descript
    1717  USE lmdz_libmath, ONLY: minmax

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

    r5116 r5117  
    5252
    5353  INTEGER :: icum, ncum
    54   logical :: first
     54  LOGICAL :: first
    5555  REAL :: zz, zqy, zfactv(jjm, llm)
    5656
    … …  
    169169  ndex3d = 0
    170170
    171   if (first) THEN
     171  IF (first) THEN
    172172    icum = 0
    173173    ! initialisation des fichiers
    … …  
    175175    !   ncum est la frequence de stokage en pas de temps
    176176    ncum = dt_cum / dt_app
    177     if (abs(ncum * dt_app - dt_cum)>1.e-5 * dt_app) THEN
     177    IF (abs(ncum * dt_app - dt_cum)>1.e-5 * dt_app) THEN
    178178      WRITE(lunout, *) &
    179179              'Pb : le pas de cumule doit etre multiple du pas'
    … …  
    183183    endif
    184184
    185     if (i_sortie==1) THEN
     185    IF (i_sortie==1) THEN
    186186      file = 'dynzon'
    187187      CALL inigrads(ifile, 1 &
    … …  
    295295    CALL histend(fileid)
    296296
    297   endif
     297  ENDIF
    298298
    299299
    … …  
    334334    flux_vQ_cum = 0.
    335335    flux_uQ_cum = 0.
    336   endif
     336  ENDIF
    337337
    338338  IF (prt_level > 5) &
    … …  
    407407  !   PAS DE TEMPS D'ECRITURE
    408408  !=====================================================================
    409   if (icum==ncum) THEN
     409  IF (icum==ncum) THEN
    410410    !=====================================================================
    411411
    … …  
    528528    ! PRINT*,'4OK'
    529529    !   sorties proprement dites
    530     if (i_sortie==1) THEN
     530    IF (i_sortie==1) THEN
    531531      do iQ = 1, nQ
    532532        do itr = 1, ntr
    … …  
    573573    !/////////////////////////////////////////////////////////////////////
    574574    icum = 0                  !///////////////////////////////////////
    575   endif ! icum.eq.ncum    !///////////////////////////////////////
     575  ENDIF ! icum.EQ.ncum    !///////////////////////////////////////
    576576  !/////////////////////////////////////////////////////////////////////
    577577  !=====================================================================

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

    r5116 r5117  
    5050  !
    5151  ! Earth-specific stuff for the first 2 tracers (water)
    52   if (planet_type=="earth") THEN
     52  IF (planet_type=="earth") THEN
    5353    ! initialisation
    5454    ! CRisi: il faut gérer tous les traceurs si on veut pouvoir faire des
    … …  
    6060    !c        CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur (a) ')
    6161    !c        CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide(a) ')
    62   endif ! of if (planet_type.eq."earth")
     62  ENDIF ! of if (planet_type.EQ."earth")
    6363  !   advection
    6464
    … …  
    7070
    7171  IF(iapptrac==iapp_tracvl) THEN
    72     if (planet_type=="earth") THEN
     72    IF (planet_type=="earth") THEN
    7373      ! Earth-specific treatment for the first 2 tracers (water)
    7474      !
    … …  
    105105      ENDDO
    106106      !
    107     endif ! of if (planet_type.eq."earth")
     107    endif ! of if (planet_type.EQ."earth")
    108108  ELSE
    109     if (planet_type=="earth") THEN
     109    IF (planet_type=="earth") THEN
    110110      ! Earth-specific treatment for the first 2 tracers (water)
    111111      dq(:, :, 1:nqtot) = 0.
    112     endif ! of if (planet_type.eq."earth")
     112    endif ! of if (planet_type.EQ."earth")
    113113  ENDIF ! of IF( iapptrac.EQ.iapp_tracvl )
    114114

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

    r5116 r5117  
    11SUBROUTINE check_isotopes_seq(q, ip1jmp1, err_msg)
    2    USE strings_mod, ONLY: maxlen, msg, strIdx, strStack, int2str, real2str
     2   USE lmdz_strings, ONLY: maxlen, msg, strIdx, strStack, int2str, real2str
    33   USE infotrac,    ONLY: nqtot, niso, nphas, isotope, isoCheck, iqIsoPha, isoSelect, &
    44                          ntiso, iH2O, nzone, tracers, isoName,  itZonIso, getKey
    … …  
    3535      iso_O17 = strIdx(isoName,'H217O')
    3636      iso_HTO = strIdx(isoName,'HTO')
    37       if (tnat1) THEN
     37      IF (tnat1) THEN
    3838              tnat(:)=1.0
    3939      else

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

    r5116 r5117  
    44
    55  USE control_mod
    6   use IOIPSL
     6  USE IOIPSL
    77  USE infotrac, ONLY: type_trac
    8   use lmdz_assert, ONLY: assert
     8  USE lmdz_assert, ONLY: assert
    99  USE comconst_mod, ONLY: dissip_deltaz, dissip_factz, dissip_zref, &
    1010          iflag_top_bound, mode_top_bound, tau_top_bound, &
    … …  
    7979  lunout = 6
    8080  CALL getin('lunout', lunout)
    81   IF (lunout /= 5 .and. lunout /= 6) THEN
     81  IF (lunout /= 5 .AND. lunout /= 6) THEN
    8282    OPEN(UNIT = lunout, FILE = 'lmdz.out', ACTION = 'write', &
    8383            STATUS = 'unknown', FORM = 'formatted')
    … …  
    308308  maxlatfilter = -1.0
    309309  CALL getin('maxlatfilter', maxlatfilter)
    310   if (maxlatfilter > 90) &
     310  IF (maxlatfilter > 90) &
    311311          CALL abort_gcm("conf_gcm", 'maxlatfilter should be <=90', 1)
    312312
    … …  
    322322  iflag_top_bound = 1
    323323  CALL getin('iflag_top_bound', iflag_top_bound)
    324   IF (iflag_top_bound < 0 .or. iflag_top_bound > 2) &
     324  IF (iflag_top_bound < 0 .OR. iflag_top_bound > 2) &
    325325          CALL abort_gcm("conf_gcm", 'iflag_top_bound must be 0, 1 or 2', 1)
    326326
    … …  
    396396  !     .........   (  modif  le 17/04/96 )   .........
    397397
    398   test_etatinit: IF (.not. etatinit) THEN
     398  test_etatinit: IF (.NOT. etatinit) THEN
    399399    !Config  Key  = clon
    400400    !Config  Desc = centre du zoom, longitude
    … …  
    828828    CALL getin('ok_strato', ok_strato)
    829829
    830     vert_prof_dissip = merge(1, 0, ok_strato .and. llm==39)
     830    vert_prof_dissip = merge(1, 0, ok_strato .AND. llm==39)
    831831    CALL getin('vert_prof_dissip', vert_prof_dissip)
    832     CALL assert(vert_prof_dissip == 0 .or. vert_prof_dissip ==  1, &
     832    CALL assert(vert_prof_dissip == 0 .OR. vert_prof_dissip ==  1, &
    833833            "bad value for vert_prof_dissip")
    834834

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

    r5116 r5117  
    77!-------------------------------------------------------------------------------
    88  USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName
    9   USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str
     9  USE lmdz_strings, ONLY: maxlen, msg, strStack, real2str, int2str
    1010  USE netcdf,      ONLY: nf90_open,  nf90_nowrite, nf90_inq_varid, &
    1111                         nf90_close, nf90_get_var, nf90_noerr
    12   USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
     12  USE lmdz_readTracFiles, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
    1313  USE control_mod, ONLY: planet_type
    1414  USE lmdz_assert_eq, ONLY: assert_eq
    … …  
    157157      iqParent = tracers(iq)%iqParent
    158158      IF(tracers(iq)%iso_iZone == 0) THEN
    159          if (tnat1) THEN
     159         IF (tnat1) THEN
    160160                 tnat=1.0
    161161                 alpha_ideal=1.0

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

    r5114 r5117  
    55!-------------------------------------------------------------------------------
    66  USE IOIPSL
    7   USE strings_mod, ONLY: maxlen
     7  USE lmdz_strings, ONLY: maxlen
    88  USE infotrac, ONLY: nqtot, tracers
    99  USE netcdf, ONLY: nf90_create, nf90_def_dim, nf90_inq_varid, nf90_global,    &
    … …  
    157157! Purpose: Write the NetCDF restart file (append).
    158158!-------------------------------------------------------------------------------
    159   USE strings_mod, ONLY: maxlen
     159  USE lmdz_strings, ONLY: maxlen
    160160  USE infotrac, ONLY: nqtot, tracers, type_trac
    161161  USE control_mod

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

    r5116 r5117  
    4141  SAVE iadvtr, massem, pbaruc, pbarvc, irec
    4242  SAVE phic, tetac
    43   logical :: first
     43  LOGICAL :: first
    4444  save first
    4545  data first/.TRUE./
    … …  
    7272    first = .FALSE.
    7373
    74   endif
     74  ENDIF
    7575
    7676  IF(iadvtr==0) THEN

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

    r5116 r5117  
    2828
    2929  ! arguments:
    30   REAL, INTENT(out) :: ucov(iip1, jjp1, llm)
    31   REAL, INTENT(out) :: vcov(iip1, jjm, llm)
    32   REAL, INTENT(in) :: pdt ! time step
     30  REAL, INTENT(OUT) :: ucov(iip1, jjp1, llm)
     31  REAL, INTENT(OUT) :: vcov(iip1, jjm, llm)
     32  REAL, INTENT(IN) :: pdt ! time step
    3333
    3434  ! local variables:
    … …  
    4747    ! set friction type
    4848    CALL getin("friction_type", friction_type)
    49     if ((friction_type<0).or.(friction_type>1)) THEN
     49    IF ((friction_type<0).OR.(friction_type>1)) THEN
    5050      abort_message = "wrong friction type"
    5151      WRITE(lunout, *)'Friction: wrong friction type', friction_type
    … …  
    5555  ENDIF
    5656
    57   if (friction_type==0) THEN
     57  IF (friction_type==0) THEN
    5858    !   calcul des composantes au carre du vent naturel
    5959    do j = 1, jjp1
    … …  
    116116      vcov(iip1, j, 1) = vcov(1, j, 1)
    117117    enddo
    118   endif ! of if (friction_type.eq.0)
     118  ENDIF ! of if (friction_type.EQ.0)
    119119
    120   if (friction_type==1) THEN
     120  IF (friction_type==1) THEN
    121121    do l = 1, llm
    122122      ucov(:, :, l) = ucov(:, :, l) * (1. - pdt * kfrict(l))
    123123      vcov(:, :, l) = vcov(:, :, l) * (1. - pdt * kfrict(l))
    124124    enddo
    125   endif
     125  ENDIF
    126126
    127127

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

    r5116 r5117  
    77
    88  USE IOIPSL
    9   USE wxios  ! ug Pour les sorties XIOS
     9  USE lmdz_wxios  ! ug Pour les sorties XIOS
    1010
    1111  USE lmdz_filtreg, ONLY: inifilr
    … …  
    9191
    9292
    93   real time_step, t_wrt, t_ops
     93  REAL time_step, t_wrt, t_ops
    9494
    9595  !      LOGICAL call_iniphys
    … …  
    108108
    109109
    110   character (len=80) :: dynhist_file, dynhistave_file
    111   character (len=20) :: modname
    112   character (len=80) :: abort_message
     110  CHARACTER (LEN=80) :: dynhist_file, dynhistave_file
     111  CHARACTER (LEN=20) :: modname
     112  CHARACTER (LEN=80) :: abort_message
    113113  ! locales pour gestion du temps
    114114  INTEGER :: an, mois, jour
    115115  REAL :: heure
    116   logical use_filtre_fft
     116  LOGICAL use_filtre_fft
    117117
    118118  !-----------------------------------------------------------------------
    … …  
    135135  CALL conf_gcm( 99, .TRUE.)
    136136
    137   if (mod(iphysiq, iperiod) /= 0) CALL abort_gcm("conf_gcm", &
     137  IF (mod(iphysiq, iperiod) /= 0) CALL abort_gcm("conf_gcm", &
    138138       "iphysiq must be a multiple of iperiod", 1)
    139139
    … …  
    167167  !      calend = 'earth_365d'
    168168
    169   if (calend == 'earth_360d') THEN
     169  IF (calend == 'earth_360d') THEN
    170170     CALL ioconf_calendar('360_day')
    171171     WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
    172   else if (calend == 'earth_365d') THEN
     172  ELSE IF (calend == 'earth_365d') THEN
    173173     CALL ioconf_calendar('noleap')
    174174     WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
    175   else if (calend == 'gregorian') THEN
     175  ELSE IF (calend == 'gregorian') THEN
    176176     CALL ioconf_calendar('gregorian')
    177177     WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
    … …  
    179179     abort_message = 'Mauvais choix de calendrier'
    180180     CALL abort_gcm(modname,abort_message,1)
    181   endif
     181  ENDIF
    182182  !-----------------------------------------------------------------------
    183183
    … …  
    203203
    204204  !  lecture du fichier start.nc
    205   if (read_start) THEN
     205  IF (read_start) THEN
    206206     ! we still need to run iniacademic to initialize some
    207207     ! constants & fields, if we run the 'newtonian' or 'SW' cases:
    208      if (iflag_phys/=1) THEN
     208     IF (iflag_phys/=1) THEN
    209209        CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
    210210     endif
    211211
    212      !        if (planet_type.eq."earth") THEN
     212     !        if (planet_type.EQ."earth") THEN
    213213     ! Load an Earth-format start file
    214214     CALL dynetat0("start.nc",vcov,ucov, &
    215215          teta,q,masse,ps,phis, time_0)
    216      !        endif ! of if (planet_type.eq."earth")
     216     !        endif ! of if (planet_type.EQ."earth")
    217217
    218218     !       WRITE(73,*) 'ucov',ucov
    … …  
    222222     !       WRITE(77,*) 'q',q
    223223
    224   endif ! of if (read_start)
     224  ENDIF ! of if (read_start)
    225225
    226226
    … …  
    228228  IF (prt_level > 9) WRITE(lunout,*) &
    229229       'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT'
    230   if (.not.read_start) THEN
     230  IF (.NOT.read_start) THEN
    231231     start_time=0.
    232232     annee_ref=anneeref
    233233     CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
    234   endif
     234  ENDIF
    235235
    236236
    … …  
    279279     WRITE(lunout,*) &
    280280          'GCM: On reinitialise a la date lue dans gcm.def'
    281   ELSE IF (annee_ref /= anneeref .or. day_ref /= dayref) THEN
     281  ELSE IF (annee_ref /= anneeref .OR. day_ref /= dayref) THEN
    282282     WRITE(lunout,*) &
    283283          'GCM: Attention les dates initiales lues dans le fichier'
    … …  
    290290  ENDIF
    291291
    292   !      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN
     292  !      if (annee_ref .NE. anneeref .OR. day_ref .NE. dayref) THEN
    293293  !        WRITE(lunout,*)
    294294  !     .  'GCM: Attention les dates initiales lues dans le fichier'
    … …  
    298298  !        WRITE(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
    299299  !        WRITE(lunout,*)' day_ref=',day_ref," dayref=",dayref
    300   !        if (raz_date .ne. 1) THEN
     300  !        if (raz_date .NE. 1) THEN
    301301  !          WRITE(lunout,*)
    302302  !     .    'GCM: On garde les dates du fichier restart'
    … …  
    331331
    332332
    333   if (iflag_phys==1) THEN
     333  IF (iflag_phys==1) THEN
    334334     ! these initialisations have already been done (via iniacademic)
    335335     ! if running in SW or Newtonian mode
    … …  
    349349     !   --------------------------
    350350     CALL inifilr
    351   endif ! of if (iflag_phys.eq.1)
     351  ENDIF ! of if (iflag_phys.EQ.1)
    352352
    353353  !-----------------------------------------------------------------------
    … …  
    365365
    366366
    367   if (nday>=0) THEN
     367  IF (nday>=0) THEN
    368368     day_end = day_ini + nday
    369369  else
    370370     day_end = day_ini - nday/day_step
    371   endif
     371  ENDIF
    372372  WRITE(lunout,300)day_ini,day_end
    373373300 FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)
    … …  
    384384  !   -------------------------------
    385385
    386   IF ((iflag_phys==1).or.(iflag_phys>=100)) THEN
     386  IF ((iflag_phys==1).OR.(iflag_phys>=100)) THEN
    387387    ! Physics:
    388388    IF (CPPKEY_PHYS) THEN
    … …  
    393393          iflag_phys)
    394394    END IF
    395   ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100))
    396 
    397   !      if (planet_type.eq."earth") THEN
     395  ENDIF ! of IF ((iflag_phys==1).OR.(iflag_phys>=100))
     396
     397  !      if (planet_type.EQ."earth") THEN
    398398  ! Write an Earth-format restart file
    399399
    … …  
    404404
    405405  time_step = zdtvr
    406   if (ok_dyn_ins) THEN
     406  IF (ok_dyn_ins) THEN
    407407     ! initialize output file for instantaneous outputs
    408408     ! t_ops = iecri * daysec ! do operations every t_ops
    … …  
    411411     CALL inithist(day_ref,annee_ref,time_step, &
    412412          t_ops,t_wrt)
    413   endif
     413  ENDIF
    414414
    415415  IF (ok_dyn_ave) THEN

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

    r5116 r5117  
    33SUBROUTINE groupe(pext, pbaru, pbarv, pbarum, pbarvm, wm)
    44
    5   use comconst_mod, ONLY: ngroup
     5  USE comconst_mod, ONLY: ngroup
    66
    77  IMPLICIT NONE
    … …  
    3737  INTEGER :: i, j, l
    3838
    39   logical :: firstcall, groupe_ok
     39  LOGICAL :: firstcall, groupe_ok
    4040  save firstcall, groupe_ok
    4141
    … …  
    4343  data groupe_ok/.TRUE./
    4444
    45   if (iim==1) THEN
     45  IF (iim==1) THEN
    4646    groupe_ok = .FALSE.
    47   endif
     47  ENDIF
    4848
    49   if (firstcall) THEN
    50     if (groupe_ok) THEN
     49  IF (firstcall) THEN
     50    IF (groupe_ok) THEN
    5151      IF(mod(iim, 2**ngroup)/=0) &
    5252              CALL abort_gcm('groupe', 'probleme du nombre de point', 1)
    5353    endif
    5454    firstcall = .FALSE.
    55   endif
     55  ENDIF
    5656
    5757
    … …  
    6363  CALL scopy(ijmllm, pbarv, 1, pbarvm, 1)
    6464
    65   if (groupe_ok) THEN
     65  IF (groupe_ok) THEN
    6666    CALL groupeun(jjp1, llm, zconvmm)
    6767    CALL groupeun(jjm, llm, pbarvm)
    … …  
    8484    pbarum(:, :, :) = pbaru(:, :, :)
    8585    pbarvm(:, :, :) = pbarv(:, :, :)
    86   endif
     86  ENDIF
    8787
    8888  !    integration de la convergence de masse de haut  en bas ......

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

    r5116 r5117  
    1010
    1111  USE getparam, ONLY: ini_getparam, fin_getparam, getpar
    12   USE Write_Field
     12  USE lmdz_write_field
    1313  USE netcdf, ONLY: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
    1414          nf90_inq_dimid, nf90_inquire_dimension, nf90_float, nf90_def_var, &
    … …  
    1616          nf90_close, nf90_inq_varid, nf90_get_var, nf90_noerr, nf90_clobber, &
    1717          nf90_64bit_offset, nf90_inq_dimid, nf90_inquire_dimension, nf90_put_var
    18   USE pres2lev_mod, ONLY: pres2lev
     18  USE lmdz_pres2lev, ONLY: pres2lev
    1919
    2020  IMPLICIT NONE
    … …  
    7272  SUBROUTINE guide_init
    7373
    74     use netcdf, ONLY: nf90_noerr
     74    USE netcdf, ONLY: nf90_noerr
    7575    USE control_mod, ONLY: day_step
    7676    USE serre_mod, ONLY: grossismx
    … …  
    101101    CALL getpar('guide_add',.FALSE.,guide_add,'forçage constant?')
    102102    CALL getpar('guide_zon',.FALSE.,guide_zon,'guidage moy zonale')
    103     if (guide_zon .and. abs(grossismx - 1.) > 0.01) &
     103    IF (guide_zon .AND. abs(grossismx - 1.) > 0.01) &
    104104         CALL abort_gcm("guide_init", &
    105105         "zonal nudging requires grid regular in longitude", 1)
    … …  
    173173! ---------------------------------------------
    174174    ncidpl=-99
    175     if (guide_plevs==1) THEN
    176        if (ncidpl==-99) THEN
     175    IF (guide_plevs==1) THEN
     176       IF (ncidpl==-99) THEN
    177177          rcod=nf90_open('apbp.nc',nf90_nowrite, ncidpl)
    178           if (rcod/=nf90_noerr) THEN
     178          IF (rcod/=nf90_noerr) THEN
    179179             abort_message=' Nudging error -> no file apbp.nc'
    180180             CALL abort_gcm(modname,abort_message,1)
    … …  
    182182       endif
    183183    elseif (guide_plevs==2) THEN
    184        if (ncidpl==-99) THEN
     184       IF (ncidpl==-99) THEN
    185185          rcod=nf90_open('P.nc',nf90_nowrite,ncidpl)
    186           if (rcod/=nf90_noerr) THEN
     186          IF (rcod/=nf90_noerr) THEN
    187187             abort_message=' Nudging error -> no file P.nc'
    188188             CALL abort_gcm(modname,abort_message,1)
    … …  
    191191
    192192    elseif (guide_u) THEN
    193            if (ncidpl==-99) THEN
     193           IF (ncidpl==-99) THEN
    194194               rcod=nf90_open('u.nc',nf90_nowrite,ncidpl)
    195                if (rcod/=nf90_noerr) THEN
     195               IF (rcod/=nf90_noerr) THEN
    196196                  CALL abort_gcm(modname, &
    197197                       ' Nudging error -> no file u.nc',1)
    … …  
    200200
    201201    elseif (guide_v) THEN
    202            if (ncidpl==-99) THEN
     202           IF (ncidpl==-99) THEN
    203203               rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
    204                if (rcod/=nf90_noerr) THEN
     204               IF (rcod/=nf90_noerr) THEN
    205205                  CALL abort_gcm(modname, &
    206206                       ' Nudging error -> no file v.nc',1)
    … …  
    208208           endif
    209209    elseif (guide_T) THEN
    210            if (ncidpl==-99) THEN
     210           IF (ncidpl==-99) THEN
    211211               rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
    212                if (rcod/=nf90_noerr) THEN
     212               IF (rcod/=nf90_noerr) THEN
    213213                  CALL abort_gcm(modname, &
    214214                       ' Nudging error -> no file T.nc',1)
    … …  
    216216           endif
    217217    elseif (guide_Q) THEN
    218            if (ncidpl==-99) THEN
     218           IF (ncidpl==-99) THEN
    219219               rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
    220                if (rcod/=nf90_noerr) THEN
     220               IF (rcod/=nf90_noerr) THEN
    221221                  CALL abort_gcm(modname, &
    222222                       ' Nudging error -> no file hur.nc',1)
    … …  
    406406        CALL tau2alpha(1,iip1,jjp1,factt,tau_min_Q,tau_max_Q,alpha_Q)
    407407! correction de rappel dans couche limite
    408         if (guide_BL) THEN
     408        IF (guide_BL) THEN
    409409             alpha_pcor(:)=1.
    410410        else
    … …  
    502502      ! compute pressures at layer interfaces
    503503      CALL pression(ip1jmp1,ap,bp,ps,p)
    504       if (pressure_exner) THEN
     504      IF (pressure_exner) THEN
    505505        CALL exner_hyb(ip1jmp1,ps,p,pks,pk)
    506506      else
    … …  
    515515    ENDIF
    516516   
    517     if (guide_u) THEN
    518         if (guide_add) THEN
     517    IF (guide_u) THEN
     518        IF (guide_add) THEN
    519519           f_add=(1.-tau)*ugui1+tau*ugui2
    520520        else
    521521           f_add=(1.-tau)*ugui1+tau*ugui2-ucov
    522522        endif
    523         if (guide_zon) CALL guide_zonave(1,jjp1,llm,f_add)
     523        IF (guide_zon) CALL guide_zonave(1,jjp1,llm,f_add)
    524524        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_u)
    525525        IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1+tau*ugui2)
    … …  
    529529    endif
    530530
    531     if (guide_T) THEN
    532         if (guide_add) THEN
     531    IF (guide_T) THEN
     532        IF (guide_add) THEN
    533533           f_add=(1.-tau)*tgui1+tau*tgui2
    534534        else
    535535           f_add=(1.-tau)*tgui1+tau*tgui2-teta
    536536        endif
    537         if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
     537        IF (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
    538538        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_T)
    539539        IF (f_out) CALL guide_out("teta",jjp1,llm,f_add/factt)
    … …  
    541541    endif
    542542
    543     if (guide_P) THEN
    544         if (guide_add) THEN
     543    IF (guide_P) THEN
     544        IF (guide_add) THEN
    545545           f_add(1:ip1jmp1,1)=(1.-tau)*psgui1+tau*psgui2
    546546        else
    547547           f_add(1:ip1jmp1,1)=(1.-tau)*psgui1+tau*psgui2-ps
    548548        endif
    549         if (guide_zon) CALL guide_zonave(2,jjp1,1,f_add(1:ip1jmp1,1))
     549        IF (guide_zon) CALL guide_zonave(2,jjp1,1,f_add(1:ip1jmp1,1))
    550550        CALL guide_addfield(ip1jmp1,1,f_add(1:ip1jmp1,1),alpha_P)
    551551!        IF (f_out) CALL guide_out("ps",jjp1,1,f_add(1:ip1jmp1,1)/factt)
    … …  
    555555    endif
    556556
    557     if (guide_Q) THEN
    558         if (guide_add) THEN
     557    IF (guide_Q) THEN
     558        IF (guide_add) THEN
    559559           f_add=(1.-tau)*qgui1+tau*qgui2
    560560        else
    561561           f_add=(1.-tau)*qgui1+tau*qgui2-q
    562562        endif
    563         if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
     563        IF (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
    564564        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_Q)
    565565        IF (f_out) CALL guide_out("q",jjp1,llm,f_add/factt)
    … …  
    567567    endif
    568568
    569     if (guide_v) THEN
    570         if (guide_add) THEN
     569    IF (guide_v) THEN
     570        IF (guide_add) THEN
    571571           f_add(1:ip1jm,:)=(1.-tau)*vgui1+tau*vgui2
    572572        else
    573573           f_add(1:ip1jm,:)=(1.-tau)*vgui1+tau*vgui2-vcov
    574574        endif
    575         if (guide_zon) CALL guide_zonave(2,jjm,llm,f_add(1:ip1jm,:))
     575        IF (guide_zon) CALL guide_zonave(2,jjm,llm,f_add(1:ip1jm,:))
    576576        CALL guide_addfield(ip1jm,llm,f_add(1:ip1jm,:),alpha_v)
    577577        IF (f_out) CALL guide_out("v",jjm,llm,vcov)
    … …  
    670670  SUBROUTINE guide_interp(psi,teta)
    671671 
    672   use exner_hyb_m, ONLY: exner_hyb
    673   use exner_milieu_m, ONLY: exner_milieu
    674   use comconst_mod, ONLY: kappa, cpp
    675   use comvert_mod, ONLY: preff, pressure_exner, bp, ap
     672  USE exner_hyb_m, ONLY: exner_hyb
     673  USE exner_milieu_m, ONLY: exner_milieu
     674  USE comconst_mod, ONLY: kappa, cpp
     675  USE comvert_mod, ONLY: preff, pressure_exner, bp, ap
     676  USE lmdz_q_sat, ONLY: q_sat
    676677  IMPLICIT NONE
    677678
    … …  
    729730
    730731END IF
    731     if (first) THEN
     732    IF (first) THEN
    732733        first=.FALSE.
    733734        WRITE(*,*)trim(modname)//' : check vertical level order'
    … …  
    742743        enddo
    743744        WRITE(*,*)trim(modname)//' invert ordering: invert_p=',invert_p
    744         if (guide_u) THEN
     745        IF (guide_u) THEN
    745746            do l=1,nlevnc
    746747              WRITE(*,*)trim(modname)//' U(',l,')=',unat2(1,1,l)
    747748            enddo
    748749        endif
    749         if (guide_T) THEN
     750        IF (guide_T) THEN
    750751            do l=1,nlevnc
    751752              WRITE(*,*)trim(modname)//' T(',l,')=',tnat2(1,1,l)
    … …  
    758759! -----------------------------------------------------------------
    759760    CALL pression( ip1jmp1, ap, bp, psi, p )
    760     if (pressure_exner) THEN
     761    IF (pressure_exner) THEN
    761762      CALL exner_hyb(ip1jmp1,psi,p,pks,pk)
    762763    else
    … …  
    803804! Conversion en variables gcm (ucov, vcov...)
    804805! -----------------------------------------------------------------
    805     if (guide_P) THEN
     806    IF (guide_P) THEN
    806807        do j=1,jjp1
    807808            do i=1,iim
    … …  
    921922! Calcul des constantes de rappel alpha (=1/tau)
    922923
    923     use comconst_mod, ONLY: pi
    924     use serre_mod, ONLY: clon, clat, grossismx, grossismy
     924    USE comconst_mod, ONLY: pi
     925    USE serre_mod, ONLY: clon, clat, grossismx, grossismy
    925926   
    926927    IMPLICIT NONE
    … …  
    944945    REAL, DIMENSION (iip1,jjp1) :: dxdys,dxdyu
    945946    REAL, DIMENSION (iip1,jjm)  :: dxdyv
    946     real dxdy_
    947     real zlat,zlon
    948     real alphamin,alphamax,xi
    949     integer i,j,ilon,ilat
     947    REAL dxdy_
     948    REAL zlat,zlon
     949    REAL alphamin,alphamax,xi
     950    INTEGER i,j,ilon,ilat
    950951    CHARACTER(LEN=20),parameter :: modname="tau2alpha"
    951952    CHARACTER (len = 80)   :: abort_message
    … …  
    962963            do j=1,pjm
    963964                do i=1,pim
    964                     if (typ==2) THEN
     965                    IF (typ==2) THEN
    965966                       zlat=rlatu(j)*180./pi
    966967                       zlon=rlonu(i)*180./pi
    … …  
    10371038            enddo
    10381039            ! Calcul de gamma
    1039             if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) THEN
     1040            IF (abs(grossismx-1.)<0.1.OR.abs(grossismy-1.)<0.1) THEN
    10401041              WRITE(*,*)trim(modname)//' ATTENTION modele peu zoome'
    10411042              WRITE(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste'
    … …  
    10441045              gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
    10451046              WRITE(*,*)trim(modname)//' gamma=',gamma
    1046               if (gamma<1.e-5) THEN
     1047              IF (gamma<1.e-5) THEN
    10471048                WRITE(*,*)trim(modname)//' gamma =',gamma,'<1e-5'
    10481049                abort_message='stopped'
    … …  
    10501051              endif
    10511052              gamma=log(0.5)/log(gamma)
    1052               if (gamma4) THEN
     1053              IF (gamma4) THEN
    10531054                gamma=min(gamma,4.)
    10541055              endif
    … …  
    10591060        do j=1,pjm
    10601061            do i=1,pim
    1061                 if (typ==1) THEN
     1062                IF (typ==1) THEN
    10621063                   dxdy_=dxdys(i,j)
    10631064                   zlat=rlatu(j)*180./pi
    … …  
    10691070                   zlat=rlatv(j)*180./pi
    10701071                endif
    1071                 if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) THEN
     1072                IF (abs(grossismx-1.)<0.1.OR.abs(grossismy-1.)<0.1) THEN
    10721073                ! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin
    10731074                    alpha(i,j)=alphamin
    … …  
    10751076                    xi=((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma
    10761077                    xi=min(xi,1.)
    1077                     IF(lat_min_g<=zlat .and. zlat<=lat_max_g) THEN
     1078                    IF(lat_min_g<=zlat .AND. zlat<=lat_max_g) THEN
    10781079                        alpha(i,j)=xi*alphamin+(1.-xi)*alphamax
    10791080                    else
    … …  
    10851086    ENDIF ! guide_reg
    10861087
    1087     if (.not. guide_add) alpha = 1. - exp(- alpha)
     1088    IF (.NOT. guide_add) alpha = 1. - exp(- alpha)
    10881089
    10891090  END SUBROUTINE tau2alpha
    … …  
    11131114! Premier appel: initialisation de la lecture des fichiers
    11141115! -----------------------------------------------------------------
    1115     if (first) THEN
     1116    IF (first) THEN
    11161117         ncidpl=-99
    11171118         WRITE(*,*) trim(modname)//': opening nudging files '
    11181119! Niveaux de pression si non constants
    1119          if (guide_plevs==1) THEN
     1120         IF (guide_plevs==1) THEN
    11201121             WRITE(*,*) trim(modname)//' Reading nudging on model levels'
    11211122             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    … …  
    11381139
    11391140! Pression si guidage sur niveaux P variables
    1140          if (guide_plevs==2) THEN
     1141         IF (guide_plevs==2) THEN
    11411142             rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
    11421143             IF (rcode/=nf90_noerr) THEN
    … …  
    11501151             ENDIF
    11511152             WRITE(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp
    1152              if (ncidpl==-99) ncidpl=ncidp
     1153             IF (ncidpl==-99) ncidpl=ncidp
    11531154         endif
    11541155
    11551156! Vent zonal
    1156          if (guide_u) THEN
     1157         IF (guide_u) THEN
    11571158             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    11581159             IF (rcode/=nf90_noerr) THEN
    … …  
    11661167             ENDIF
    11671168             WRITE(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu
    1168              if (ncidpl==-99) ncidpl=ncidu
     1169             IF (ncidpl==-99) ncidpl=ncidu
    11691170
    11701171             status=nf90_inq_dimid(ncidu, "LONU", dimid)
    … …  
    11851186
    11861187! Vent meridien
    1187          if (guide_v) THEN
     1188         IF (guide_v) THEN
    11881189             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    11891190             IF (rcode/=nf90_noerr) THEN
    … …  
    11971198             ENDIF
    11981199             WRITE(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv
    1199              if (ncidpl==-99) ncidpl=ncidv
     1200             IF (ncidpl==-99) ncidpl=ncidv
    12001201             
    12011202             status=nf90_inq_dimid(ncidv, "LONV", dimid)
    … …  
    12181219
    12191220! Temperature
    1220          if (guide_T) THEN
     1221         IF (guide_T) THEN
    12211222             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    12221223             IF (rcode/=nf90_noerr) THEN
    … …  
    12301231             ENDIF
    12311232             WRITE(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt
    1232              if (ncidpl==-99) ncidpl=ncidt
     1233             IF (ncidpl==-99) ncidpl=ncidt
    12331234
    12341235             status=nf90_inq_dimid(ncidt, "LONV", dimid)
    … …  
    12491250
    12501251! Humidite
    1251          if (guide_Q) THEN
     1252         IF (guide_Q) THEN
    12521253             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    12531254             IF (rcode/=nf90_noerr) THEN
    … …  
    12611262             ENDIF
    12621263             WRITE(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
    1263              if (ncidpl==-99) ncidpl=ncidQ
     1264             IF (ncidpl==-99) ncidpl=ncidQ
    12641265
    12651266             status=nf90_inq_dimid(ncidQ, "LONV", dimid)
    … …  
    12801281
    12811282! Pression de surface
    1282          if ((guide_P).OR.(guide_modele)) THEN
     1283         IF ((guide_P).OR.(guide_modele)) THEN
    12831284             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    12841285             IF (rcode/=nf90_noerr) THEN
    … …  
    12941295         endif
    12951296! Coordonnee verticale
    1296          if (guide_plevs==0) THEN
     1297         IF (guide_plevs==0) THEN
    12971298              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    12981299              IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    … …  
    13001301         endif
    13011302! Coefs ap, bp pour calcul de la pression aux differents niveaux
    1302          if (guide_plevs==1) THEN
     1303         IF (guide_plevs==1) THEN
    13031304             status=nf90_get_var(ncidpl,varidap,apnc,[1],[nlevnc])
    13041305             status=nf90_get_var(ncidpl,varidbp,bpnc,[1],[nlevnc])
    … …  
    13281329
    13291330! Pression
    1330      if (guide_plevs==2) THEN
     1331     IF (guide_plevs==2) THEN
    13311332         status=nf90_get_var(ncidp,varidp,pnat2,start,count)
    13321333         IF (invert_y) THEN
    … …  
    13381339
    13391340!  Vent zonal
    1340      if (guide_u) THEN
     1341     IF (guide_u) THEN
    13411342         status=nf90_get_var(ncidu,varidu,unat2,start,count)
    13421343         IF (invert_y) THEN
    … …  
    13461347
    13471348!  Temperature
    1348      if (guide_T) THEN
     1349     IF (guide_T) THEN
    13491350         status=nf90_get_var(ncidt,varidt,tnat2,start,count)
    13501351         IF (invert_y) THEN
    … …  
    13541355
    13551356!  Humidite
    1356      if (guide_Q) THEN
     1357     IF (guide_Q) THEN
    13571358         status=nf90_get_var(ncidQ,varidQ,qnat2,start,count)
    13581359         IF (invert_y) THEN
    … …  
    13631364
    13641365!  Vent meridien
    1365      if (guide_v) THEN
     1366     IF (guide_v) THEN
    13661367         count(2)=jjm
    13671368         status=nf90_get_var(ncidv,varidv,vnat2,start,count)
    … …  
    13721373
    13731374!  Pression de surface
    1374      if ((guide_P).OR.(guide_modele))  THEN
     1375     IF ((guide_P).OR.(guide_modele))  THEN
    13751376         start(3)=timestep
    13761377         start(4)=0
    … …  
    14131414! Premier appel: initialisation de la lecture des fichiers
    14141415! -----------------------------------------------------------------
    1415     if (first) THEN
     1416    IF (first) THEN
    14161417         ncidpl=-99
    14171418         WRITE(*,*)trim(modname)//' : opening nudging files '
    14181419! Ap et Bp si niveaux de pression hybrides
    1419          if (guide_plevs==1) THEN
     1420         IF (guide_plevs==1) THEN
    14201421           WRITE(*,*)trim(modname)//' Reading nudging on model levels'
    14211422           rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    … …  
    14371438         endif
    14381439! Pression
    1439          if (guide_plevs==2) THEN
     1440         IF (guide_plevs==2) THEN
    14401441           rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
    14411442           IF (rcode/=nf90_noerr) THEN
    … …  
    14491450           ENDIF
    14501451           WRITE(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
    1451            if (ncidpl==-99) ncidpl=ncidp
     1452           IF (ncidpl==-99) ncidpl=ncidp
    14521453         endif
    14531454! Vent zonal
    1454          if (guide_u) THEN
     1455         IF (guide_u) THEN
    14551456           rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    14561457           IF (rcode/=nf90_noerr) THEN
    … …  
    14641465           ENDIF
    14651466           WRITE(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
    1466            if (ncidpl==-99) ncidpl=ncidu
     1467           IF (ncidpl==-99) ncidpl=ncidu
    14671468         endif
    14681469! Vent meridien
    1469          if (guide_v) THEN
     1470         IF (guide_v) THEN
    14701471           rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    14711472           IF (rcode/=nf90_noerr) THEN
    … …  
    14791480           ENDIF
    14801481           WRITE(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
    1481            if (ncidpl==-99) ncidpl=ncidv
     1482           IF (ncidpl==-99) ncidpl=ncidv
    14821483         endif
    14831484! Temperature
    1484          if (guide_T) THEN
     1485         IF (guide_T) THEN
    14851486           rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    14861487           IF (rcode/=nf90_noerr) THEN
    … …  
    14941495           ENDIF
    14951496           WRITE(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
    1496            if (ncidpl==-99) ncidpl=ncidt
     1497           IF (ncidpl==-99) ncidpl=ncidt
    14971498         endif
    14981499! Humidite
    1499          if (guide_Q) THEN
     1500         IF (guide_Q) THEN
    15001501           rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    15011502           IF (rcode/=nf90_noerr) THEN
    … …  
    15091510           ENDIF
    15101511           WRITE(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
    1511            if (ncidpl==-99) ncidpl=ncidQ
     1512           IF (ncidpl==-99) ncidpl=ncidQ
    15121513         endif
    15131514! Pression de surface
    1514          if ((guide_P).OR.(guide_modele)) THEN
     1515         IF ((guide_P).OR.(guide_modele)) THEN
    15151516           rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    15161517           IF (rcode/=nf90_noerr) THEN
    … …  
    15261527         endif
    15271528! Coordonnee verticale
    1528          if (guide_plevs==0) THEN
     1529         IF (guide_plevs==0) THEN
    15291530           rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    15301531           IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    … …  
    15321533         endif
    15331534! Coefs ap, bp pour calcul de la pression aux differents niveaux
    1534          if (guide_plevs==1) THEN
     1535         IF (guide_plevs==1) THEN
    15351536             status=nf90_get_var(ncidpl,varidap,apnc,[1],[nlevnc])
    15361537             status=nf90_get_var(ncidpl,varidbp,bpnc,[1],[nlevnc])
    … …  
    15591560
    15601561!  Pression
    1561      if (guide_plevs==2) THEN
     1562     IF (guide_plevs==2) THEN
    15621563         status=nf90_get_var(ncidp,varidp,zu,start,count)
    15631564         DO i=1,iip1
    … …  
    15721573     endif
    15731574!  Vent zonal
    1574      if (guide_u) THEN
     1575     IF (guide_u) THEN
    15751576         status=nf90_get_var(ncidu,varidu,zu,start,count)
    15761577         DO i=1,iip1
    … …  
    15851586
    15861587!  Temperature
    1587      if (guide_T) THEN
     1588     IF (guide_T) THEN
    15881589         status=nf90_get_var(ncidt,varidt,zu,start,count)
    15891590         DO i=1,iip1
    … …  
    15981599
    15991600!  Humidite
    1600      if (guide_Q) THEN
     1601     IF (guide_Q) THEN
    16011602         status=nf90_get_var(ncidQ,varidQ,zu,start,count)
    16021603         DO i=1,iip1
    … …  
    16111612
    16121613!  Vent meridien
    1613      if (guide_v) THEN
     1614     IF (guide_v) THEN
    16141615         count(2)=jjm
    16151616         status=nf90_get_var(ncidv,varidv,zv,start,count)
    … …  
    16251626
    16261627!  Pression de surface
    1627      if ((guide_P).OR.(guide_plevs==1))  THEN
     1628     IF ((guide_P).OR.(guide_plevs==1))  THEN
    16281629         start(3)=timestep
    16291630         start(4)=0
    … …  
    17971798!===========================================================================
    17981799  SUBROUTINE correctbid(iim,nl,x)
    1799     integer iim,nl
    1800     real x(iim+1,nl)
    1801     integer i,l
    1802     real zz
     1800    INTEGER iim,nl
     1801    REAL x(iim+1,nl)
     1802    INTEGER i,l
     1803    REAL zz
    18031804
    18041805    do l=1,nl

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

    r5116 r5117  
    77  USE infotrac,    ONLY: nqtot, niso, iqIsoPha, tracers, getKey, isoName
    88  USE control_mod, ONLY: day_step,planet_type
    9   use exner_hyb_m, ONLY: exner_hyb
    10   use exner_milieu_m, ONLY: exner_milieu
     9  USE exner_hyb_m, ONLY: exner_hyb
     10  USE exner_milieu_m, ONLY: exner_milieu
    1111  USE IOIPSL, ONLY: getin
    12   USE Write_Field
     12  USE lmdz_write_field
    1313  USE comconst_mod, ONLY: cpp, kappa, g, daysec, dtvr, pi, im, jm
    1414  USE logic_mod, ONLY: iflag_phys, read_start
    … …  
    1616  USE temps_mod, ONLY: annee_ref, day_ini, day_ref
    1717  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
    18   USE readTracFiles_mod, ONLY: addPhase
    19   use netcdf, ONLY: nf90_nowrite,nf90_open,nf90_noerr,nf90_inq_varid,nf90_close,nf90_get_var
     18  USE lmdz_readTracFiles, ONLY: addPhase
     19  USE netcdf, ONLY: nf90_nowrite,nf90_open,nf90_noerr,nf90_inq_varid,nf90_close,nf90_get_var
     20  USE lmdz_ran1, ONLY: ran1
    2021
    2122  !   Author:    Frederic Hourdin      original: 15/01/93
    … …  
    5657  REAL phi(ip1jmp1,llm)                  ! geopotentiel
    5758  REAL ddsin,zsig,tetapv,w_pv  ! variables auxiliaires
    58   real tetastrat ! potential temperature in the stratosphere, in K
    59   real tetajl(jjp1,llm)
     59  REAL tetastrat ! potential temperature in the stratosphere, in K
     60  REAL tetajl(jjp1,llm)
    6061  INTEGER i,j,l,lsup,ij, iq, iName, iPhase, iqParent
    6162
    6263  INTEGER :: nid_relief,varid,ierr
    63   real, dimension(iip1,jjp1) :: relief
     64  REAL, DIMENSION(iip1,jjp1) :: relief
    6465
    6566  REAL teta0,ttp,delt_y,delt_z,eps ! Constantes pour profil de T
    … …  
    6970  REAL phi_pv,dphi_pv,gam_pv,tetanoise   ! Constantes pour polar vortex
    7071
    71   real zz,ran1
    72   integer idum
     72  REAL zz
     73  INTEGER idum
    7374
    7475  REAL zdtvr, tnat, alpha_ideal
    … …  
    7980
    8081  ! Sanity check: verify that options selected by user are not incompatible
    81   if ((iflag_phys==1).and. .not. read_start) THEN
     82  IF ((iflag_phys==1).AND. .NOT. read_start) THEN
    8283    WRITE(lunout,*) trim(modname)," error: if read_start is set to ", &
    8384    " false then iflag_phys should not be 1"
    … …  
    8586    " (iflag_phys >= 100)"
    8687    CALL abort_gcm(modname,"incompatible iflag_phys==1 and read_start==.FALSE.",1)
    87   endif
     88  ENDIF
    8889 
    8990  !-----------------------------------------------------------------------
    … …  
    109110  ang0       = 0.
    110111
    111   if (llm == 1) THEN
     112  IF (llm == 1) THEN
    112113     ! specific initializations for the shallow water case
    113114     kappa=1
    114   endif
     115  ENDIF
    115116
    116117  CALL iniconst
    … …  
    136137     relief=0.
    137138     ierr = nf90_open ('relief_in.nc', nf90_nowrite,nid_relief)
    138      if (ierr==nf90_noerr) THEN
     139     IF (ierr==nf90_noerr) THEN
    139140         ierr=nf90_inq_varid(nid_relief,'RELIEF',varid)
    140          if (ierr==nf90_noerr) THEN
     141         IF (ierr==nf90_noerr) THEN
    141142              ierr=nf90_get_var(nid_relief,varid,relief(1:iim,1:jjp1))
    142143              relief(iip1,:)=relief(1,:)
    … …  
    164165     CALL pression ( ip1jmp1, ap, bp, ps, p       )
    165166
    166      if (pressure_exner) THEN
     167     IF (pressure_exner) THEN
    167168       CALL exner_hyb( ip1jmp1, ps, p, pks, pk)
    168169     else
    … …  
    172173  ENDIF
    173174
    174   if (llm == 1) THEN
     175  IF (llm == 1) THEN
    175176     ! initialize fields for the shallow water case, if required
    176      if (.not.read_start) THEN
     177     IF (.NOT.read_start) THEN
    177178        phis(:)=0.
    178179        q(:,:,:)=0
    179180        CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
    180181     endif
    181   endif
     182  ENDIF
    182183
    183184  academic_case: if (iflag_phys >= 2) THEN
    … …  
    249250           tetajl(j,l)=teta0-delt_y*ddsin*ddsin+eps*ddsin &
    250251                -delt_z*(1.-ddsin*ddsin)*log(zsig)
    251            if (planet_type=="giant") THEN
     252           IF (planet_type=="giant") THEN
    252253             tetajl(j,l)=teta0+(delt_y*                   &
    253254                ((sin(rlatu(j)*3.14159*eps+0.0001))**2)   &
    … …  
    293294
    294295        ! winds
    295         if (ok_geost) THEN
     296        IF (ok_geost) THEN
    296297           CALL ugeostr(phi,ucov)
    297298        else
    … …  
    301302
    302303        ! bulk initialization of tracers
    303         if (planet_type=="earth") THEN
     304        IF (planet_type=="earth") THEN
    304305           ! Earth: first two tracers will be water
    305306           do iq=1,nqtot
    … …  
    311312              ! distill de Rayleigh très simplifiée
    312313              iName    = tracers(iq)%iso_iName
    313               if (niso <= 0 .OR. iName <= 0) CYCLE
     314              IF (niso <= 0 .OR. iName <= 0) CYCLE
    314315              iPhase   = tracers(iq)%iso_iPhase
    315316              iqParent = tracers(iq)%iqParent
    316317              IF(tracers(iq)%iso_iZone == 0) THEN
    317                  if (tnat1) THEN
     318                 IF (tnat1) THEN
    318319                         tnat=1.0
    319320                         alpha_ideal=1.0
    … …  
    358359
    359360     ENDIF ! of IF (.NOT. read_start)
    360   endif academic_case
     361  ENDIF academic_case
    361362
    362363END SUBROUTINE iniacademic

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

    r5116 r5117  
    116116  do jj = 1, jmn + 1
    117117    do j = 1, jmo + 1
    118       if((cn(jj)<d(j)).and.(dn(jj)>c(j)))THEN
     118      IF((cn(jj)<d(j)).AND.(dn(jj)>c(j)))THEN
    119119        do ii = 1, imn + 1
    120120          do i = 1, imo + 1
    121             if (((an(ii)<b(i)).and.(bn(ii)>a(i))) &
    122                     .or. ((an(ii)<b(i) - 2 * pi).and.(bn(ii)>a(i) - 2 * pi) &
    123                             .and.(b(i) - 2 * pi<-pi)) &
    124                     .or. ((an(ii)<b(i) + 2 * pi).and.(bn(ii)>a(i) + 2 * pi) &
    125                             .and.(a(i) + 2 * pi>pi)) &
     121            IF (((an(ii)<b(i)).AND.(bn(ii)>a(i))) &
     122                    .OR. ((an(ii)<b(i) - 2 * pi).AND.(bn(ii)>a(i) - 2 * pi) &
     123                            .AND.(b(i) - 2 * pi<-pi)) &
     124                    .OR. ((an(ii)<b(i) + 2 * pi).AND.(bn(ii)>a(i) + 2 * pi) &
     125                            .AND.(a(i) + 2 * pi>pi)) &
    126126                    )THEN
    127127              ktotal = ktotal + 1
    … …  
    133133              dd = min(d(j), dn(jj))
    134134              cc = cn(jj)
    135               if (cc< c(j))cc = c(j)
    136               if((an(ii)<b(i) - 2 * pi).and. &
     135              IF (cc< c(j))cc = c(j)
     136              IF((an(ii)<b(i) - 2 * pi).AND. &
    137137                      (bn(ii)>a(i) - 2 * pi)) THEN
    138138                bb = min(b(i) - 2 * pi, bn(ii))
    139139                aa = an(ii)
    140                 if (aa<a(i) - 2 * pi) aa = a(i) - 2 * pi
    141               else if((an(ii)<b(i) + 2 * pi).and. &
     140                IF (aa<a(i) - 2 * pi) aa = a(i) - 2 * pi
     141              ELSE IF((an(ii)<b(i) + 2 * pi).AND. &
    142142                      (bn(ii)>a(i) + 2 * pi)) THEN
    143143                bb = min(b(i) + 2 * pi, bn(ii))
    144144                aa = an(ii)
    145                 if (aa<a(i) + 2 * pi) aa = a(i) + 2 * pi
     145                IF (aa<a(i) + 2 * pi) aa = a(i) + 2 * pi
    146146              else
    147147                bb = min(b(i), bn(ii))
    148148                aa = an(ii)
    149                 if (aa<a(i)) aa = a(i)
     149                IF (aa<a(i)) aa = a(i)
    150150              end if
    151151              intersec(ktotal) = (bb - aa) * (sin(dd) - sin(cc))
    … …  
    165165  !  i = ik(k)
    166166  !  j = jk(k)
    167   !  if ((ii.eq.10).and.(jj.eq.10).and.(i.eq.10).and.(j.eq.10))THEN
    168   !  if (jj.eq.2.and.(ii.eq.1))THEN
     167  !  if ((ii.EQ.10).AND.(jj.EQ.10).AND.(i.EQ.10).AND.(j.EQ.10))THEN
     168  !  if (jj.EQ.2.AND.(ii.EQ.1))THEN
    169169  !      WRITE(*,*) '**************** jj=',jj,'ii=',ii
    170170  !      WRITE(*,*) 'i,j =',i,j

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

    r5116 r5117  
    66        )
    77
    8   use control_mod, ONLY: planet_type
    9   use comconst_mod, ONLY: pi
     8  USE control_mod, ONLY: planet_type
     9  USE comconst_mod, ONLY: pi
    1010  USE logic_mod, ONLY: leapf
    11   use comvert_mod, ONLY: ap, bp
     11  USE comvert_mod, ONLY: ap, bp
    1212  USE temps_mod, ONLY: dt
    1313
    … …  
    3838  !   ----------
    3939
    40   integer, intent(in) :: nq ! number of tracers to handle in this routine
    41   real, intent(inout) :: vcov(ip1jm, llm) ! covariant meridional wind
    42   real, intent(inout) :: ucov(ip1jmp1, llm) ! covariant zonal wind
    43   real, intent(inout) :: teta(ip1jmp1, llm) ! potential temperature
    44   real, intent(inout) :: q(ip1jmp1, llm, nq) ! advected tracers
    45   real, intent(inout) :: ps(ip1jmp1) ! surface pressure
    46   real, intent(inout) :: masse(ip1jmp1, llm) ! atmospheric mass
    47   real, intent(in) :: phis(ip1jmp1) ! ground geopotential !!! unused
     40  INTEGER, INTENT(IN) :: nq ! number of tracers to handle in this routine
     41  REAL, INTENT(INOUT) :: vcov(ip1jm, llm) ! covariant meridional wind
     42  REAL, INTENT(INOUT) :: ucov(ip1jmp1, llm) ! covariant zonal wind
     43  REAL, INTENT(INOUT) :: teta(ip1jmp1, llm) ! potential temperature
     44  REAL, INTENT(INOUT) :: q(ip1jmp1, llm, nq) ! advected tracers
     45  REAL, INTENT(INOUT) :: ps(ip1jmp1) ! surface pressure
     46  REAL, INTENT(INOUT) :: masse(ip1jmp1, llm) ! atmospheric mass
     47  REAL, INTENT(IN) :: phis(ip1jmp1) ! ground geopotential !!! unused
    4848  ! values at previous time step
    49   real, intent(inout) :: vcovm1(ip1jm, llm)
    50   real, intent(inout) :: ucovm1(ip1jmp1, llm)
    51   real, intent(inout) :: tetam1(ip1jmp1, llm)
    52   real, intent(inout) :: psm1(ip1jmp1)
    53   real, intent(inout) :: massem1(ip1jmp1, llm)
     49  REAL, INTENT(INOUT) :: vcovm1(ip1jm, llm)
     50  REAL, INTENT(INOUT) :: ucovm1(ip1jmp1, llm)
     51  REAL, INTENT(INOUT) :: tetam1(ip1jmp1, llm)
     52  REAL, INTENT(INOUT) :: psm1(ip1jmp1)
     53  REAL, INTENT(INOUT) :: massem1(ip1jmp1, llm)
    5454  ! the tendencies to add
    55   real, intent(in) :: dv(ip1jm, llm)
    56   real, intent(in) :: du(ip1jmp1, llm)
    57   real, intent(in) :: dteta(ip1jmp1, llm)
    58   real, intent(in) :: dp(ip1jmp1)
    59   real, intent(in) :: dq(ip1jmp1, llm, nq) !!! unused
    60   ! real,intent(out) :: finvmaold(ip1jmp1,llm) !!! unused
     55  REAL, INTENT(IN) :: dv(ip1jm, llm)
     56  REAL, INTENT(IN) :: du(ip1jmp1, llm)
     57  REAL, INTENT(IN) :: dteta(ip1jmp1, llm)
     58  REAL, INTENT(IN) :: dp(ip1jmp1)
     59  REAL, INTENT(IN) :: dq(ip1jmp1, llm, nq) !!! unused
     60  ! REAL,INTENT(OUT) :: finvmaold(ip1jmp1,llm) !!! unused
    6161
    6262  !   Local:
    … …  
    203203  !$$$      ENDIF
    204204
    205   if (planet_type=="earth") THEN
     205  IF (planet_type=="earth") THEN
    206206    ! Earth-specific treatment of first 2 tracers (water)
    207207    DO l = 1, llm
    … …  
    238238    ! CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
    239239
    240   endif ! of if (planet_type.eq."earth")
     240  ENDIF ! of if (planet_type.EQ."earth")
    241241  !
    242242  !

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

    r5116 r5117  
    4848  REAL :: totn, tots
    4949
    50   logical :: firstcall, firsttest, aire_ok
     50  LOGICAL :: firstcall, firsttest, aire_ok
    5151  save firsttest
    5252  data firsttest /.TRUE./
    … …  
    108108  !---------------------------------------------------------------
    109109  !  TEST  TEST  TEST  TEST  TEST  TEST  TEST  TEST  TEST  TEST
    110   !!       if (.not.(firsttest)) goto 99
     110  !!       if (.NOT.(firsttest)) goto 99
    111111  !!       firsttest = .FALSE.
    112112  !! !     write (*,*) 'INTERP. HORIZ. : TEST SUR LES AIRES:'
    … …  
    128128  !!        do ii=1, imn+1
    129129  !!          r = airen(ii,jj)/airetest(ii,jj)
    130   !!          if ((r.gt.1.001).or.(r.lt.0.999)) THEN
     130  !!          if ((r.gt.1.001).OR.(r.lt.0.999)) THEN
    131131  !! !             write (*,*) '********** PROBLEME D'' AIRES !!!',
    132132  !! !     &                   ' DANS L''INTERPOLATION HORIZONTALE'

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

    r5116 r5117  
    77
    88  !IM : pour sortir les param. du modele dans un fis. netcdf 110106
    9   use IOIPSL
     9  USE IOIPSL
    1010  USE infotrac, ONLY: nqtot, isoCheck
    1111  USE guide_mod, ONLY: guide_main
    12   USE write_field, ONLY: writefield
     12  USE lmdz_write_field, ONLY: writefield
    1313  USE control_mod, ONLY: nday, day_step, planet_type, offline, &
    1414          iconser, iphysiq, iperiod, dissip_period, &
    1515          iecri, ip_ebil_dyn, ok_dynzon, ok_dyn_ins, &
    1616          periodav, ok_dyn_ave, output_grads_dyn
    17   use exner_hyb_m, ONLY: exner_hyb
    18   use exner_milieu_m, ONLY: exner_milieu
     17  USE exner_hyb_m, ONLY: exner_hyb
     18  USE exner_milieu_m, ONLY: exner_milieu
    1919  USE comvert_mod, ONLY: ap, bp, pressure_exner, presnivs
    2020  USE comconst_mod, ONLY: cpp, dtphys, dtvr, pi, ihf
    … …  
    2323  USE temps_mod, ONLY: jD_ref, jH_ref, itaufin, day_ini, day_ref, &
    2424          start_time, dt
    25   USE strings_mod, ONLY: msg
     25  USE lmdz_strings, ONLY: msg
    2626  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_PHYS
    2727  USE lmdz_description, ONLY: descript
    … …  
    146146  REAL :: zx_tmp_2d(iip1, jjp1)
    147147  INTEGER :: ndex2d(iip1 * jjp1)
    148   logical :: ok_sync
     148  LOGICAL :: ok_sync
    149149  parameter (ok_sync = .TRUE.)
    150   logical :: physic
     150  LOGICAL :: physic
    151151
    152152  data callinigrads/.TRUE./
    … …  
    174174  CHARACTER(LEN = 80) :: abort_message
    175175
    176   logical :: dissip_conservative
     176  LOGICAL :: dissip_conservative
    177177  save dissip_conservative
    178178  data dissip_conservative/.TRUE./
    … …  
    188188  INTEGER :: itau_w   ! pas de temps ecriture = itap + itau_phy
    189189
    190   if (nday>=0) THEN
     190  IF (nday>=0) THEN
    191191    itaufin = nday * day_step
    192192  else
    193193    itaufin = -nday
    194   endif
     194  ENDIF
    195195  itaufinp1 = itaufin + 1
    196196  itau = 0
    197197  physic = .TRUE.
    198   if (iflag_phys==0.or.iflag_phys==2) physic = .FALSE.
     198  IF (iflag_phys==0.OR.iflag_phys==2) physic = .FALSE.
    199199
    200200  ! iday = day_ini+itau/day_step
    … …  
    212212  dq(:, :, :) = 0.
    213213  CALL pression (ip1jmp1, ap, bp, ps, p)
    214   if (pressure_exner) THEN
     214  IF (pressure_exner) THEN
    215215    CALL exner_hyb(ip1jmp1, ps, p, pks, pk, pkf)
    216216  else
    217217    CALL exner_milieu(ip1jmp1, ps, p, pks, pk, pkf)
    218   endif
     218  ENDIF
    219219
    220220  !-----------------------------------------------------------------------
    … …  
    236236  CALL check_isotopes_seq(q, ip1jmp1, 'leapfrog 321')
    237237
    238   if (ok_guide) THEN
     238  IF (ok_guide) THEN
    239239    CALL guide_main(itau,ucov,vcov,teta,q,masse,ps)
    240   endif
     240  ENDIF
    241241
    242242
    … …  
    299299            apdiss = .TRUE.
    300300    IF(MOD(itau, iphysiq)==0.AND..NOT.forward &
    301             .and. physic) apphys = .TRUE.
     301            .AND. physic) apphys = .TRUE.
    302302  ELSE
    303303    ! Leapfrog/Matsuno time stepping
    … …  
    310310  ! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
    311311  ! supress dissipation step
    312   if (llm==1) THEN
     312  IF (llm==1) THEN
    313313    apdiss = .FALSE.
    314   endif
     314  ENDIF
    315315
    316316  CALL check_isotopes_seq(q, ip1jmp1, 'leapfrog 589')
    … …  
    389389
    390390    CALL pression (ip1jmp1, ap, bp, ps, p)
    391     if (pressure_exner) THEN
     391    IF (pressure_exner) THEN
    392392      CALL exner_hyb(ip1jmp1, ps, p, pks, pk, pkf)
    393393    else
    … …  
    453453    CALL pression (ip1jmp1, ap, bp, ps, p)
    454454    CALL massdair(p, masse)
    455     if (pressure_exner) THEN
     455    IF (pressure_exner) THEN
    456456      CALL exner_hyb(ip1jmp1, ps, p, pks, pk, pkf)
    457457    else
    … …  
    485485    ENDDO ! of DO l=1,llm
    486486
    487     if (planet_type=="giant") THEN
     487    IF (planet_type=="giant") THEN
    488488      ! add an intrinsic heat flux at the base of the atmosphere
    489489      teta(:, 1) = teta(:, 1) + dtvr * aire(:) * ihf / cpp / masse(:, 1)
    … …  
    511511
    512512  CALL pression (ip1jmp1, ap, bp, ps, p)
    513   if (pressure_exner) THEN
     513  IF (pressure_exner) THEN
    514514    CALL exner_hyb(ip1jmp1, ps, p, pks, pk, pkf)
    515515  else
    516516    CALL exner_milieu(ip1jmp1, ps, p, pks, pk, pkf)
    517   endif
     517  ENDIF
    518518  CALL massdair(p, masse)
    519519
    … …  
    539539
    540540    !------------------------------------------------------------------------
    541     if (dissip_conservative) THEN
     541    IF (dissip_conservative) THEN
    542542      ! On rajoute la tendance due a la transform. Ec -> E therm. cree
    543543      ! lors de la dissipation
    … …  
    570570    ENDDO
    571571
    572     if (1 == 0) THEN
     572    IF (1 == 0) THEN
    573573      !!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
    574574      !!!                     2) should probably not be here anyway
    … …  
    621621
    622622    IF(itau == itaufinp1) THEN
    623       if (flag_verif) THEN
     623      IF (flag_verif) THEN
    624624        WRITE(79, *) 'ucov', ucov
    625625        WRITE(80, *) 'vcov', vcov
    … …  
    668668    IF(MOD(itau, iecri)==0) THEN
    669669      ! ! Ehouarn: output only during LF or Backward Matsuno
    670       if (leapf.or.(.not.leapf.and.(.not.forward))) THEN
     670      IF (leapf.OR.(.NOT.leapf.AND.(.NOT.forward))) THEN
    671671        CALL geopot(ip1jmp1, teta, pk, pks, phis, phi)
    672672        unat = 0.
    … …  
    675675          vnat(:, l) = vcov(:, l) / cv(:)
    676676        enddo
    677           if (ok_dyn_ins) THEN
     677          IF (ok_dyn_ins) THEN
    678678            ! WRITE(lunout,*) "leapfrog: CALL writehist, itau=",itau
    679679           CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis)
    … …  
    685685          endif ! of if (ok_dyn_ins)
    686686        ! For some Grads outputs of fields
    687         if (output_grads_dyn) THEN
     687        IF (output_grads_dyn) THEN
    688688          include "write_grads_dyn.h"
    689689        endif
    690       endif ! of if (leapf.or.(.not.leapf.and.(.not.forward)))
     690      endif ! of if (leapf.OR.(.NOT.leapf.AND.(.NOT.forward)))
    691691    ENDIF ! of IF(MOD(itau,iecri).EQ.0)
    692692
    … …  
    694694
    695695
    696       ! if (planet_type.eq."earth") THEN
     696      ! if (planet_type.EQ."earth") THEN
    697697      ! Write an Earth-format restart file
    698698      CALL dynredem1("restart.nc", start_time, &
    699699              vcov, ucov, teta, q, masse, ps)
    700       ! endif ! of if (planet_type.eq."earth")
     700      ! END IF ! of if (planet_type.EQ."earth")
    701701
    702702      CLOSE(99)
    703       if (ok_guide) THEN
     703      IF (ok_guide) THEN
    704704        ! ! set ok_guide to false to avoid extra output
    705705        ! ! in following forward step
    … …  
    741741    ! !    ELSEIF (MOD(itau-1,iperiod).EQ.0)
    742742
    743   ELSE ! of IF (.not.purmats)
     743  ELSE ! of IF (.NOT.purmats)
    744744
    745745    CALL check_isotopes_seq(q, ip1jmp1, 'leapfrog 1664')
    … …  
    799799          vnat(:, l) = vcov(:, l) / cv(:)
    800800        enddo
    801           if (ok_dyn_ins) THEN
     801          IF (ok_dyn_ins) THEN
    802802             ! WRITE(lunout,*) "leapfrog: CALL writehist (b)",
    803803  ! &                        itau,iecri
    … …  
    805805          endif ! of if (ok_dyn_ins)
    806806        ! For some Grads outputs
    807         if (output_grads_dyn) THEN
     807        IF (output_grads_dyn) THEN
    808808          include "write_grads_dyn.h"
    809809        endif
    … …  
    812812
    813813      IF(itau==itaufin) THEN
    814         ! if (planet_type.eq."earth") THEN
     814        ! if (planet_type.EQ."earth") THEN
    815815        CALL dynredem1("restart.nc", start_time, &
    816816                vcov, ucov, teta, q, masse, ps)
    817         ! endif ! of if (planet_type.eq."earth")
    818         if (ok_guide) THEN
     817        ! END IF ! of if (planet_type.EQ."earth")
     818        IF (ok_guide) THEN
    819819          ! ! set ok_guide to false to avoid extra output
    820820          ! ! in following forward step
    … …  
    828828    ENDIF ! of IF (forward)
    829829
    830   END IF ! of IF(.not.purmats)
     830  END IF ! of IF(.NOT.purmats)
    831831
    832832END SUBROUTINE leapfrog

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

    r5116 r5117  
    44
    55  USE infotrac, ONLY: niso, ntiso, iqIsoPha, tracers
    6   USE strings_mod, ONLY: strIdx
    7   USE readTracFiles_mod, ONLY: addPhase
     6  USE lmdz_strings, ONLY: strIdx
     7  USE lmdz_readTracFiles, ONLY: addPhase
    88  IMPLICIT none
    99  !
    … …  
    6464  DO k = 1, llm
    6565    DO i = 1, ip1jmp1
    66       if (seuil_liq - q(i, k, iq_liq) > 0.d0) THEN
    67         if (niso > 0) zx_defau_diag(i, k, 2) = AMAX1 &
     66      IF (seuil_liq - q(i, k, iq_liq) > 0.d0) THEN
     67        IF (niso > 0) zx_defau_diag(i, k, 2) = AMAX1 &
    6868                (seuil_liq - q(i, k, iq_liq), 0.0)
    6969
    … …  
    8080    !cc      zx_abc = dpres(k) / dpres(k-1)
    8181    DO i = 1, ip1jmp1
    82       if (seuil_vap - q(i, k, iq_vap) > 0.d0) THEN
    83         if (niso > 0) zx_defau_diag(i, k, 1) &
     82      IF (seuil_vap - q(i, k, iq_vap) > 0.d0) THEN
     83        IF (niso > 0) zx_defau_diag(i, k, 1) &
    8484                = AMAX1(seuil_vap - q(i, k, iq_vap), 0.0)
    8585
    … …  
    112112
    113113  !WRITE(*,*) 'qminimum 128'
    114   if (niso > 0) THEN
     114  IF (niso > 0) THEN
    115115    ! CRisi: traiter de même les traceurs d'eau
    116116    ! Mais il faut les prendre à l'envers pour essayer de conserver la
    … …  
    121121    ! génant
    122122    DO i = 1, ip1jmp1
    123       if (zx_pump(i)>0.0) THEN
     123      IF (zx_pump(i)>0.0) THEN
    124124        q_follow(i, 1, 1) = q_follow(i, 1, 1) + zx_pump(i)
    125125      endif !if (zx_pump(i).gt.0.0) THEN
    … …  
    130130    do k = 2, llm
    131131      DO i = 1, ip1jmp1
    132         if (zx_defau_diag(i, k, 1)>0.0) THEN
     132        IF (zx_defau_diag(i, k, 1)>0.0) THEN
    133133          ! on ajoute la vapeur en k
    134134          do ixt = 1, ntiso
    … …  
    162162    do k = 1, llm
    163163      DO i = 1, ip1jmp1
    164         if (zx_defau_diag(i, k, 2)>0.0) THEN
     164        IF (zx_defau_diag(i, k, 2)>0.0) THEN
    165165          ! ! on ajoute eau liquide en k en k
    166166          do ixt = 1, ntiso
    … …  
    183183    CALL check_isotopes_seq(q, ip1jmp1, 'qminimum 197')
    184184
    185   endif !if (niso > 0) THEN
     185  ENDIF !if (niso > 0) THEN
    186186  ! !WRITE(*,*) 'qminimum 188'
    187187

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

    r5116 r5117  
    101101  CALL conf_gcm( 99, .TRUE.)
    102102
    103   if (mod(iphysiq, iperiod) /= 0) CALL abort_gcm("conf_gcm", &
     103  IF (mod(iphysiq, iperiod) /= 0) CALL abort_gcm("conf_gcm", &
    104104       "iphysiq must be a multiple of iperiod", 1)
    105105

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

    r5116 r5117  
    2929
    3030  INTEGER :: ilon, ilev
    31   logical :: lnew
     31  LOGICAL :: lnew
    3232
    3333  REAL :: pgcm(ilon, ilev)
    … …  
    5454  ! PRINT*,'tetalevel pres=',pres
    5555  !=====================================================================
    56   if (lnew) THEN
     56  IF (lnew) THEN
    5757    !   on réinitialise les réindicages et les poids
    5858    !=====================================================================
    … …  
    110110    enddo
    111111
    112   endif ! lnew
     112  ENDIF ! lnew
    113113
    114114  !======================================================================
    … …  
    125125  do i = 1, ilon
    126126    !IM      if (pgcm(i,1).LT.pres) THEN
    127     if (pgcm(i, 1)>pres) THEN
     127    IF (pgcm(i, 1)>pres) THEN
    128128      ! Qpres(i)=1e33
    129129      Qpres(i) = 1e+20

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

    r5116 r5117  
    2929
    3030  INTEGER :: ilon, ilev
    31   logical :: lnew
     31  LOGICAL :: lnew
    3232
    3333  REAL :: pgcm(ilon, ilev)
    … …  
    5454  ! PRINT*,'tetalevel pres=',pres
    5555  !=====================================================================
    56   if (lnew) THEN
     56  IF (lnew) THEN
    5757    !   on réinitialise les réindicages et les poids
    5858    !=====================================================================
    … …  
    110110    enddo
    111111
    112   endif ! lnew
     112  ENDIF ! lnew
    113113
    114114  !======================================================================
    … …  
    125125  do i = 1, ilon
    126126    !IM      if (pgcm(i,1).LT.pres) THEN
    127     if (pgcm(i, 1)>pres) THEN
     127    IF (pgcm(i, 1)>pres) THEN
    128128      ! Qpres(i)=1e33
    129129      Qpres(i) = 1e+20

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

    r5116 r5117  
    5858  !   ----------
    5959
    60   real, intent(inout) :: ucov(iip1, jjp1, llm) ! covariant zonal wind
    61   real, intent(inout) :: vcov(iip1, jjm, llm) ! covariant meridional wind
    62   real, intent(inout) :: teta(iip1, jjp1, llm) ! potential temperature
    63   real, intent(in) :: masse(iip1, jjp1, llm) ! mass of atmosphere
    64   real, intent(in) :: dt ! time step (s) of sponge model
     60  REAL, INTENT(INOUT) :: ucov(iip1, jjp1, llm) ! covariant zonal wind
     61  REAL, INTENT(INOUT) :: vcov(iip1, jjm, llm) ! covariant meridional wind
     62  REAL, INTENT(INOUT) :: teta(iip1, jjp1, llm) ! potential temperature
     63  REAL, INTENT(IN) :: masse(iip1, jjp1, llm) ! mass of atmosphere
     64  REAL, INTENT(IN) :: dt ! time step (s) of sponge model
    6565
    6666  !   Local:
    … …  
    7272  INTEGER :: i
    7373  REAL, SAVE :: rdamp(llm) ! quenching coefficient
    74   real, save :: lambda(llm) ! inverse or quenching time scale (Hz)
     74  REAL, save :: lambda(llm) ! inverse or quenching time scale (Hz)
    7575
    7676  LOGICAL, SAVE :: first = .TRUE.
    … …  
    7878  INTEGER :: j, l
    7979
    80   if (iflag_top_bound==0) return
     80  IF (iflag_top_bound==0) return
    8181
    82   if (first) THEN
    83     if (iflag_top_bound==1) THEN
     82  IF (first) THEN
     83    IF (iflag_top_bound==1) THEN
    8484      ! sponge quenching over the topmost 4 atmospheric layers
    8585      lambda(:) = 0.
    … …  
    8888      lambda(llm - 2) = tau_top_bound / 4.
    8989      lambda(llm - 3) = tau_top_bound / 8.
    90     else if (iflag_top_bound==2) THEN
     90    ELSE IF (iflag_top_bound==2) THEN
    9191      ! sponge quenching over topmost layers down to pressures which are
    9292      ! higher than 100 times the topmost layer pressure
    … …  
    103103    WRITE(lunout, *)'p (Pa)  z(km)  tau(s)   1./tau (Hz)'
    104104    do l = 1, llm
    105       if (rdamp(l)/=0.) THEN
     105      IF (rdamp(l)/=0.) THEN
    106106        WRITE(lunout, '(6(1pe12.4,1x))') &
    107107                presnivs(l), log(preff / presnivs(l)) * scaleheight, &
    … …  
    110110    enddo
    111111    first = .FALSE.
    112   endif ! of if (first)
     112  ENDIF ! of if (first)
    113113
    114114  CALL massbar(masse, massebx, masseby)
    115115
    116116  ! compute zonal average of vcov and u
    117   if (mode_top_bound>=2) THEN
     117  IF (mode_top_bound>=2) THEN
    118118    do l = 1, llm
    119119      do j = 1, jjm
    … …  
    144144    vzon(:, :) = 0.
    145145    uzon(:, :) = 0.
    146   endif ! of if (mode_top_bound.ge.2)
     146  ENDIF ! of if (mode_top_bound.ge.2)
    147147
    148148  ! compute zonal average of potential temperature, if necessary
    149   if (mode_top_bound>=3) THEN
     149  IF (mode_top_bound>=3) THEN
    150150    do l = 1, llm
    151151      do j = 2, jjm ! excluding poles
    … …  
    159159      enddo
    160160    enddo
    161   endif ! of if (mode_top_bound.ge.3)
     161  ENDIF ! of if (mode_top_bound.ge.3)
    162162
    163   if (mode_top_bound>=1) THEN
     163  IF (mode_top_bound>=1) THEN
    164164    ! Apply sponge quenching on vcov:
    165165    do l = 1, llm
    … …  
    181181      enddo
    182182    enddo
    183   endif ! of if (mode_top_bound.ge.1)
     183  ENDIF ! of if (mode_top_bound.ge.1)
    184184
    185   if (mode_top_bound>=3) THEN
     185  IF (mode_top_bound>=3) THEN
    186186    ! Apply sponge quenching on teta:
    187187    do l = 1, llm
    … …  
    193193      enddo
    194194    enddo
    195   endif ! of if (mode_top_bound.ge.3)
     195  ENDIF ! of if (mode_top_bound.ge.3)
    196196
    197197END SUBROUTINE top_bound

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

    r5116 r5117  
    293293
    294294  IF(n0>0) THEN
    295   if (prt_level > 2) PRINT *, &
     295  IF (prt_level > 2) PRINT *, &
    296296        'Nombre de points pour lesquels on advect plus que le' &
    297297        ,'contenu de la maille : ',n0
    … …  
    302302  !   indicage des mailles concernees par le traitement special
    303303           DO ij=iip2,ip1jm
    304               IF(iadvplus(ij,l)==1.and.mod(ij,iip1)/=0) THEN
     304              IF(iadvplus(ij,l)==1.AND.mod(ij,iip1)/=0) THEN
    305305                 iju=iju+1
    306306                 indu(iju)=ij
    … …  
    372372        !Mvals: veiller a ce qu'on n'ait pas de denominateur nul
    373373        masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
    374         if (q(ij,l,iq)>min_qParent) THEN
     374        IF (q(ij,l,iq)>min_qParent) THEN
    375375          Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    376376        else
    … …  
    688688        ! !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    689689        masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
    690         if (q(ij,l,iq)>min_qParent) THEN
     690        IF (q(ij,l,iq)>min_qParent) THEN
    691691          Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    692692        else
    … …  
    855855        ! !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    856856        masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
    857         if (q(ij,l,iq)>min_qParent) THEN
     857        IF (q(ij,l,iq)>min_qParent) THEN
    858858          Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    859859        else

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

    r5116 r5117  
    391391        !   indicage des mailles concernees par le traitement special
    392392        DO ij = iip2, ip1jm
    393           IF(iadvplus(ij, l)==1.and.mod(ij, iip1)/=0) THEN
     393          IF(iadvplus(ij, l)==1.AND.mod(ij, iip1)/=0) THEN
    394394            iju = iju + 1
    395395            indu(iju) = ij

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

    r5116 r5117  
    1818  REAL :: field(imx * jmx * lmx)
    1919
    20   integer, parameter :: wp = selected_real_kind(p = 6, r = 36)
     20  INTEGER, parameter :: wp = selected_real_kind(p = 6, r = 36)
    2121  real(wp) field4(imx * jmx * lmx)
    2222
    … …  
    2828  INTEGER :: im, jm, lm, i, j, l, iv, iii, iji, iif, ijf
    2929
    30   logical :: writectl
     30  LOGICAL :: writectl
    3131
    32   writectl = .false.
     32  writectl = .FALSE.
    3333
    3434  ! print*,if,iid(if),jid(if),ifd(if),jfd(if)
    … …  
    4646  IF(firsttime(if)) THEN
    4747    IF(name==var(1, if)) THEN
    48       firsttime(if) = .false.
     48      firsttime(if) = .FALSE.
    4949      ivar(if) = 1
    5050      print*, 'fin de l initialiation de l ecriture du fichier'
    … …  
    6363      ! print*,'if ivar(if) nld ',if,ivar(if),nld(ivar(if),if)
    6464    endif
    65     writectl = .true.
     65    writectl = .TRUE.
    6666    itime(if) = 1
    6767  else
    6868    ivar(if) = mod(ivar(if), nvar(if)) + 1
    69     if (ivar(if)==nvar(if)) THEN
    70       writectl = .true.
     69    IF (ivar(if)==nvar(if)) THEN
     70      writectl = .TRUE.
    7171      itime(if) = itime(if) + 1
    7272    endif
    … …  
    8181      CALL abort_gcm("wrgrads", "problem", 1)
    8282    endif
    83   endif
     83  ENDIF
    8484
    8585  ! print*,'ivar(if),nvar(if),var(ivar(if),if),writectl'
    … …  
    9595                    , i = iii, iif), j = iji, ijf)
    9696  enddo
    97   if (writectl) THEN
     97  IF (writectl) THEN
    9898    file = fichier(if)
    9999    !   WARNING! on reecrase le fichier .ctl a chaque ecriture
    … …  
    105105    WRITE(unit(if), '(a12)') 'UNDEF 1.0E30'
    106106    WRITE(unit(if), '(a5,1x,a40)') 'TITLE ', title(if)
    107     CALL formcoord(unit(if), im, xd(iii, if), 1., .false., 'XDEF')
    108     CALL formcoord(unit(if), jm, yd(iji, if), 1., .true., 'YDEF')
    109     CALL formcoord(unit(if), lm, zd(1, if), 1., .false., 'ZDEF')
     107    CALL formcoord(unit(if), im, xd(iii, if), 1., .FALSE., 'XDEF')
     108    CALL formcoord(unit(if), jm, yd(iji, if), 1., .TRUE., 'YDEF')
     109    CALL formcoord(unit(if), lm, zd(1, if), 1., .FALSE., 'ZDEF')
    110110    WRITE(unit(if), '(a4,i10,a30)') &
    111111            'TDEF ', itime(if), ' LINEAR 02JAN1987 1MO '
    … …  
    123123    close(unit(if))
    124124
    125   endif ! writectl
     125  ENDIF ! writectl
    126126
    127127END SUBROUTINE wrgrads

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/write_paramLMDZ_dyn.h

    r5116 r5117  
    107107     .               zx_tmp_2d,iip1*jjp1,ndex2d)
    108108c
    109       if (calend == 'earth_360d') THEN
     109      IF (calend == 'earth_360d') THEN
    110110        zx_tmp_2d(1:iip1,1:jjp1)=1.
    111       else if (calend == 'earth_365d') THEN
     111      ELSE IF (calend == 'earth_365d') THEN
    112112        zx_tmp_2d(1:iip1,1:jjp1)=2.
    113       else if (calend == 'earth_366d') THEN
     113      ELSE IF (calend == 'earth_366d') THEN
    114114        zx_tmp_2d(1:iip1,1:jjp1)=3.
    115115      endif
    … …  
    240240c=================================================================
    241241c
    242       if (ok_sync) THEN
     242      IF (ok_sync) THEN
    243243        CALL histsync(nid_ctesGCM)
    244244      endif
Note: See TracChangeset for help on using the changeset viewer.