Ignore:
Timestamp:
Jul 24, 2024, 2:54:37 PM (2 months ago)
Author:
abarral
Message:

rename modules properly lmdz_*
move ismin, ismax, minmax into new lmdz_libmath.f90
(lint) uppercase fortran keywords

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

Legend:

Unmodified
Added
Removed

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

    r5103 r5116  
    1919  !     ierr    = severity of situation ( = 0 normal )
    2020
    21   character(len = *), intent(in) :: modname
     21  CHARACTER(LEN = *), intent(in) :: modname
    2222  integer, intent(in) :: ierr
    23   character(len = *), intent(in) :: message
     23  CHARACTER(LEN = *), intent(in) :: message
    2424
    25   write(lunout, *) 'in abort_gcm'
     25  WRITE(lunout, *) 'in abort_gcm'
    2626
    2727  IF (using_xios) THEN
    … …  
    3333  CALL restclo
    3434  CALL getin_dump
    35   write(lunout, *) 'Stopping in ', modname
    36   write(lunout, *) 'Reason = ', message
    37   if (ierr == 0) then
    38     write(lunout, *) 'Everything is cool'
     35  WRITE(lunout, *) 'Stopping in ', modname
     36  WRITE(lunout, *) 'Reason = ', message
     37  if (ierr == 0) THEN
     38    WRITE(lunout, *) 'Everything is cool'
    3939    stop
    4040  else
    41     write(lunout, *) 'Houston, we have a problem, ierr = ', ierr
     41    WRITE(lunout, *) 'Houston, we have a problem, ierr = ', ierr
    4242    stop 1
    4343  endif

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

    r5113 r5116  
    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

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

    r5114 r5116  
    1515  USE strings_mod, ONLY: int2str
    1616  USE lmdz_description, ONLY: descript
     17  USE lmdz_libmath, ONLY: minmax
    1718
    1819  IMPLICIT NONE
    … …  
    4950  REAL, DIMENSION(ip1jmp1, llm) :: pbaruc, pbarug, massem, wg
    5051  REAL, DIMENSION(ip1jm, llm) :: pbarvc, pbarvg
    51   EXTERNAL  minmax
    5252  SAVE massem, pbaruc, pbarvc
    5353  !---------------------------------------------------------------------------
    … …  
    129129  ! Calcul des criteres CFL en X, Y et Z
    130130  !-------------------------------------------------------------------------
    131   IF(countcfl == 0.) then
     131  IF(countcfl == 0.) THEN
    132132    cflxmax(:) = 0.
    133133    cflymax(:) = 0.
    … …  
    141141  DO l = 1, llm
    142142    DO ij = iip2, ip1jm - 1
    143       IF(pbarug(ij, l)>=0.) then
     143      IF(pbarug(ij, l)>=0.) THEN
    144144        cflx(ij, l) = pbarug(ij, l) * dtvr / masse(ij, l)
    145145      ELSE
    … …  
    157157  DO l = 1, llm
    158158    DO ij = 1, ip1jm
    159       IF(pbarvg(ij, l)>=0.) then
     159      IF(pbarvg(ij, l)>=0.) THEN
    160160        cfly(ij, l) = pbarvg(ij, l) * dtvr / masse(ij, l)
    161161      ELSE
    … …  
    184184  ! Par defaut, on sort le diagnostic des CFL tous les jours.
    185185  ! Si on veut le sortir a chaque pas d'advection en cas de plantage
    186   !       IF(countcfl==iapp_tracvl) then
     186  !       IF(countcfl==iapp_tracvl) THEN
    187187  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    188   IF(countcfl==day_step) then
     188  IF(countcfl==day_step) THEN
    189189    DO l = 1, llm
    190190      WRITE(lunout, *) 'L, CFL[xyz]max:', l, cflxmax(l), cflymax(l), cflzmax(l)

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

    r5106 r5116  
    3636  !   ===========
    3737
    38   integer :: ntrac
    39   real :: dt_app, dt_cum
    40   real :: ps(iip1, jjp1)
    41   real :: masse(iip1, jjp1, llm), pk(iip1, jjp1, llm)
    42   real :: flux_u(iip1, jjp1, llm)
    43   real :: flux_v(iip1, jjm, llm)
    44   real :: teta(iip1, jjp1, llm)
    45   real :: phi(iip1, jjp1, llm)
    46   real :: ucov(iip1, jjp1, llm)
    47   real :: vcov(iip1, jjm, llm)
    48   real :: trac(iip1, jjp1, llm, ntrac)
     38  INTEGER :: ntrac
     39  REAL :: dt_app, dt_cum
     40  REAL :: ps(iip1, jjp1)
     41  REAL :: masse(iip1, jjp1, llm), pk(iip1, jjp1, llm)
     42  REAL :: flux_u(iip1, jjp1, llm)
     43  REAL :: flux_v(iip1, jjm, llm)
     44  REAL :: teta(iip1, jjp1, llm)
     45  REAL :: phi(iip1, jjp1, llm)
     46  REAL :: ucov(iip1, jjp1, llm)
     47  REAL :: vcov(iip1, jjm, llm)
     48  REAL :: trac(iip1, jjp1, llm, ntrac)
    4949
    5050  !   Local :
    5151  !   =======
    5252
    53   integer :: icum, ncum
     53  INTEGER :: icum, ncum
    5454  logical :: first
    55   real :: zz, zqy, zfactv(jjm, llm)
    56 
    57   integer :: nQ
     55  REAL :: zz, zqy, zfactv(jjm, llm)
     56
     57  INTEGER :: nQ
    5858  parameter (nQ = 7)
    5959
    … …  
    6464  character*6, save :: unites(nQ)
    6565
    66   character(len = 10) :: file
    67   integer :: ifile
     66  CHARACTER(LEN = 10) :: file
     67  INTEGER :: ifile
    6868  parameter (ifile = 4)
    6969
    70   integer :: itemp, igeop, iecin, iang, iu, iovap, iun
    71   integer :: i_sortie
     70  INTEGER :: itemp, igeop, iecin, iang, iu, iovap, iun
     71  INTEGER :: i_sortie
    7272
    7373  save first, icum, ncum
    … …  
    7575  save i_sortie
    7676
    77   real :: time
    78   integer :: itau
     77  REAL :: time
     78  INTEGER :: itau
    7979  save time, itau
    8080  data time, itau/0., 0/
    … …  
    8484  data i_sortie/1/
    8585
    86   real :: ww
     86  REAL :: ww
    8787
    8888  !   variables dynamiques intermédiaires
    … …  
    9595
    9696  !   champ contenant les scalaires advectés.
    97   real :: Q(iip1, jjp1, llm, nQ)
     97  REAL :: Q(iip1, jjp1, llm, nQ)
    9898
    9999  !   champs cumulés
    100   real :: ps_cum(iip1, jjp1)
    101   real :: masse_cum(iip1, jjp1, llm)
    102   real :: flux_u_cum(iip1, jjp1, llm)
    103   real :: flux_v_cum(iip1, jjm, llm)
    104   real :: Q_cum(iip1, jjp1, llm, nQ)
    105   real :: flux_uQ_cum(iip1, jjp1, llm, nQ)
    106   real :: flux_vQ_cum(iip1, jjm, llm, nQ)
    107   real :: flux_wQ_cum(iip1, jjp1, llm, nQ)
    108   real :: dQ(iip1, jjp1, llm, nQ)
     100  REAL :: ps_cum(iip1, jjp1)
     101  REAL :: masse_cum(iip1, jjp1, llm)
     102  REAL :: flux_u_cum(iip1, jjp1, llm)
     103  REAL :: flux_v_cum(iip1, jjm, llm)
     104  REAL :: Q_cum(iip1, jjp1, llm, nQ)
     105  REAL :: flux_uQ_cum(iip1, jjp1, llm, nQ)
     106  REAL :: flux_vQ_cum(iip1, jjm, llm, nQ)
     107  REAL :: flux_wQ_cum(iip1, jjp1, llm, nQ)
     108  REAL :: dQ(iip1, jjp1, llm, nQ)
    109109
    110110  save ps_cum, masse_cum, flux_u_cum, flux_v_cum
    … …  
    112112
    113113  !   champs de tansport en moyenne zonale
    114   integer :: ntr, itr
     114  INTEGER :: ntr, itr
    115115  parameter (ntr = 5)
    116116
    … …  
    122122  character*10, save :: zunites(ntr, nQ)
    123123
    124   integer :: iave, itot, immc, itrs, istn
     124  INTEGER :: iave, itot, immc, itrs, istn
    125125  data iave, itot, immc, itrs, istn/1, 2, 3, 4, 5/
    126   character(len = 3) :: ctrs(ntr)
     126  CHARACTER(LEN = 3) :: ctrs(ntr)
    127127  data ctrs/'  ', 'TOT', 'MMC', 'TRS', 'STN'/
    128128
    129   real :: zvQ(jjm, llm, ntr, nQ), zvQtmp(jjm, llm)
    130   real :: zavQ(jjm, ntr, nQ), psiQ(jjm, llm + 1, nQ)
    131   real :: zmasse(jjm, llm), zamasse(jjm)
    132 
    133   real :: zv(jjm, llm), psi(jjm, llm + 1)
    134 
    135   integer :: i, j, l, iQ
     129  REAL :: zvQ(jjm, llm, ntr, nQ), zvQtmp(jjm, llm)
     130  REAL :: zavQ(jjm, ntr, nQ), psiQ(jjm, llm + 1, nQ)
     131  REAL :: zmasse(jjm, llm), zamasse(jjm)
     132
     133  REAL :: zv(jjm, llm), psi(jjm, llm + 1)
     134
     135  INTEGER :: i, j, l, iQ
    136136
    137137
    … …  
    139139  !   ---------------------------------------------------------
    140140
    141   character(len = 10) :: infile
    142 
    143   integer :: fileid
    144   integer :: thoriid, zvertiid
     141  CHARACTER(LEN = 10) :: infile
     142
     143  INTEGER :: fileid
     144  INTEGER :: thoriid, zvertiid
    145145  save fileid
    146146
    147   integer :: ndex3d(jjm * llm)
     147  INTEGER :: ndex3d(jjm * llm)
    148148
    149149  !   Variables locales
    150150  !
    151   integer :: tau0
    152   real :: zjulian
    153   character(len = 3) :: str
    154   character(len = 10) :: ctrac
    155   integer :: ii, jj
    156   integer :: zan, dayref
    157   !
    158   real :: rlong(jjm), rlatg(jjm)
     151  INTEGER :: tau0
     152  REAL :: zjulian
     153  CHARACTER(LEN = 3) :: str
     154  CHARACTER(LEN = 10) :: ctrac
     155  INTEGER :: ii, jj
     156  INTEGER :: zan, dayref
     157  !
     158  REAL :: rlong(jjm), rlatg(jjm)
    159159
    160160
    … …  
    169169  ndex3d = 0
    170170
    171   if (first) then
    172 
     171  if (first) THEN
    173172    icum = 0
    174173    ! initialisation des fichiers
    … …  
    176175    !   ncum est la frequence de stokage en pas de temps
    177176    ncum = dt_cum / dt_app
    178     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
    179178      WRITE(lunout, *) &
    180179              'Pb : le pas de cumule doit etre multiple du pas'
    … …  
    184183    endif
    185184
    186     if (i_sortie==1) then
     185    if (i_sortie==1) THEN
    187186      file = 'dynzon'
    188187      CALL inigrads(ifile, 1 &
    … …  
    235234    do iQ = 1, nQ
    236235      do itr = 1, ntr
    237         if(itr==1) then
     236        IF(itr==1) THEN
    238237          znom(itr, iQ) = nom(iQ)
    239238          znoml(itr, iQ) = nom(iQ)
    … …  
    327326  !=====================================================================
    328327  !
    329   if(icum==0) then
     328  IF(icum==0) THEN
    330329    ps_cum = 0.
    331330    masse_cum = 0.
    … …  
    408407  !   PAS DE TEMPS D'ECRITURE
    409408  !=====================================================================
    410   if (icum==ncum) then
     409  if (icum==ncum) THEN
    411410    !=====================================================================
    412411
    … …  
    529528    ! PRINT*,'4OK'
    530529    !   sorties proprement dites
    531     if (i_sortie==1) then
     530    if (i_sortie==1) THEN
    532531      do iQ = 1, nQ
    533532        do itr = 1, ntr

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

    r5113 r5116  
    3030  REAL :: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm), masse(ip1jmp1, llm)
    3131  REAL :: p(ip1jmp1, llmp1), q(ip1jmp1, llm, nqtot)
    32   real :: dq(ip1jmp1, llm, nqtot)
     32  REAL :: dq(ip1jmp1, llm, nqtot)
    3333  REAL :: teta(ip1jmp1, llm), pk(ip1jmp1, llm)
    3434  REAL :: flxw(ip1jmp1, llm)
    … …  
    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
    … …  
    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      !
    … …  
    8484      ENDDO
    8585
    86       !write(*,*) 'caladvtrac 87'
     86      !WRITE(*,*) 'caladvtrac 87'
    8787      CALL qminimum(q, nqtot, finmasse)
    88       !write(*,*) 'caladvtrac 89'
     88      !WRITE(*,*) 'caladvtrac 89'
    8989
    9090      CALL SCOPY   (ip1jmp1 * llm, masse, 1, finmasse, 1)
    … …  
    107107    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.

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

    r4984 r5116  
    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

    r5113 r5116  
    66  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, &
    … …  
    414414
    415415    IF(ABS(clat - clatt)>= 0.001)  THEN
    416       write(lunout, *)'conf_gcm: La valeur de clat passee par run.def', &
     416      WRITE(lunout, *)'conf_gcm: La valeur de clat passee par run.def', &
    417417              ' est differente de celle lue sur le fichier  start '
    418418      CALL abort_gcm("conf_gcm", "stopped", 1)
    … …  
    428428
    429429    IF(ABS(grossismx - grossismxx)>= 0.001)  THEN
    430       write(lunout, *)'conf_gcm: La valeur de grossismx passee par ', &
     430      WRITE(lunout, *)'conf_gcm: La valeur de grossismx passee par ', &
    431431              'run.def est differente de celle lue sur le fichier  start '
    432432      CALL abort_gcm("conf_gcm", "stopped", 1)
    … …  
    442442
    443443    IF(ABS(grossismy - grossismyy)>= 0.001)  THEN
    444       write(lunout, *)'conf_gcm: La valeur de grossismy passee par ', &
     444      WRITE(lunout, *)'conf_gcm: La valeur de grossismy passee par ', &
    445445              'run.def est differente de celle lue sur le fichier  start '
    446446      CALL abort_gcm("conf_gcm", "stopped", 1)
    … …  
    448448
    449449    IF(grossismx<1.)  THEN
    450       write(lunout, *) &
     450      WRITE(lunout, *) &
    451451              'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
    452452      CALL abort_gcm("conf_gcm", "stopped", 1)
    … …  
    456456
    457457    IF(grossismy<1.)  THEN
    458       write(lunout, *) &
     458      WRITE(lunout, *) &
    459459              'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
    460460      CALL abort_gcm("conf_gcm", "stopped", 1)
    … …  
    463463    ENDIF
    464464
    465     write(lunout, *)'conf_gcm: alphax alphay', alphax, alphay
     465    WRITE(lunout, *)'conf_gcm: alphax alphay', alphax, alphay
    466466
    467467    !    alphax et alphay sont les anciennes formulat. des grossissements
    … …  
    477477    IF(.NOT.fxyhypb)  THEN
    478478      IF(fxyhypbb)     THEN
    479         write(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
    480         write(lunout, *)' *** fxyhypb lu sur le fichier start est ', &
     479        WRITE(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
     480        WRITE(lunout, *)' *** fxyhypb lu sur le fichier start est ', &
    481481                'F alors  qu il est  T  sur  run.def  ***'
    482482        CALL abort_gcm("conf_gcm", "stopped", 1)
    … …  
    484484    ELSE
    485485      IF(.NOT.fxyhypbb)   THEN
    486         write(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
    487         write(lunout, *)' ***  fxyhypb lu sur le fichier start est ', &
     486        WRITE(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
     487        WRITE(lunout, *)' ***  fxyhypb lu sur le fichier start est ', &
    488488                'T alors  qu il est  F  sur  run.def  ****  '
    489489        CALL abort_gcm("conf_gcm", "stopped", 1)
    … …  
    501501    IF(fxyhypb)  THEN
    502502      IF(ABS(dzoomx - dzoomxx)>= 0.001)  THEN
    503         write(lunout, *)'conf_gcm: La valeur de dzoomx passee par ', &
     503        WRITE(lunout, *)'conf_gcm: La valeur de dzoomx passee par ', &
    504504                'run.def est differente de celle lue sur le fichier  start '
    505505        CALL abort_gcm("conf_gcm", "stopped", 1)
    … …  
    517517    IF(fxyhypb)  THEN
    518518      IF(ABS(dzoomy - dzoomyy)>= 0.001)  THEN
    519         write(lunout, *)'conf_gcm: La valeur de dzoomy passee par ', &
     519        WRITE(lunout, *)'conf_gcm: La valeur de dzoomy passee par ', &
    520520                'run.def est differente de celle lue sur le fichier  start '
    521521        CALL abort_gcm("conf_gcm", "stopped", 1)
    … …  
    532532    IF(fxyhypb)  THEN
    533533      IF(ABS(taux - tauxx)>= 0.001)  THEN
    534         write(lunout, *)'conf_gcm: La valeur de taux passee par ', &
     534        WRITE(lunout, *)'conf_gcm: La valeur de taux passee par ', &
    535535                'run.def est differente de celle lue sur le fichier  start '
    536536        CALL abort_gcm("conf_gcm", "stopped", 1)
    … …  
    547547    IF(fxyhypb)  THEN
    548548      IF(ABS(tauy - tauyy)>= 0.001)  THEN
    549         write(lunout, *)'conf_gcm: La valeur de tauy passee par ', &
     549        WRITE(lunout, *)'conf_gcm: La valeur de tauy passee par ', &
    550550                'run.def est differente de celle lue sur le fichier  start '
    551551        CALL abort_gcm("conf_gcm", "stopped", 1)
    … …  
    567567      IF(.NOT.ysinus)  THEN
    568568        IF(ysinuss)     THEN
    569           write(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
    570           write(lunout, *)' *** ysinus lu sur le fichier start est F', &
     569          WRITE(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
     570          WRITE(lunout, *)' *** ysinus lu sur le fichier start est F', &
    571571                  ' alors  qu il est  T  sur  run.def  ***'
    572572          CALL abort_gcm("conf_gcm", "stopped", 1)
    … …  
    574574      ELSE
    575575        IF(.NOT.ysinuss)   THEN
    576           write(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
    577           write(lunout, *)' *** ysinus lu sur le fichier start est T', &
     576          WRITE(lunout, *)' ********  PBS DANS  CONF_GCM  ******** '
     577          WRITE(lunout, *)' *** ysinus lu sur le fichier start est T', &
    578578                  ' alors  qu il est  F  sur  run.def  ****  '
    579579          CALL abort_gcm("conf_gcm", "stopped", 1)
    … …  
    634634    CALL getin('ok_dyn_ave', ok_dyn_ave)
    635635
    636     write(lunout, *)' #########################################'
    637     write(lunout, *)' Configuration des parametres du gcm: '
    638     write(lunout, *)' planet_type = ', planet_type
    639     write(lunout, *)' calend = ', calend
    640     write(lunout, *)' dayref = ', dayref
    641     write(lunout, *)' anneeref = ', anneeref
    642     write(lunout, *)' nday = ', nday
    643     write(lunout, *)' day_step = ', day_step
    644     write(lunout, *)' iperiod = ', iperiod
    645     write(lunout, *)' nsplit_phys = ', nsplit_phys
    646     write(lunout, *)' iconser = ', iconser
    647     write(lunout, *)' iecri = ', iecri
    648     write(lunout, *)' periodav = ', periodav
    649     write(lunout, *)' output_grads_dyn = ', output_grads_dyn
    650     write(lunout, *)' dissip_period = ', dissip_period
    651     write(lunout, *)' lstardis = ', lstardis
    652     write(lunout, *)' nitergdiv = ', nitergdiv
    653     write(lunout, *)' nitergrot = ', nitergrot
    654     write(lunout, *)' niterh = ', niterh
    655     write(lunout, *)' tetagdiv = ', tetagdiv
    656     write(lunout, *)' tetagrot = ', tetagrot
    657     write(lunout, *)' tetatemp = ', tetatemp
    658     write(lunout, *)' coefdis = ', coefdis
    659     write(lunout, *)' purmats = ', purmats
    660     write(lunout, *)' read_start = ', read_start
    661     write(lunout, *)' iflag_phys = ', iflag_phys
    662     write(lunout, *)' iphysiq = ', iphysiq
    663     write(lunout, *)' clonn = ', clonn
    664     write(lunout, *)' clatt = ', clatt
    665     write(lunout, *)' grossismx = ', grossismx
    666     write(lunout, *)' grossismy = ', grossismy
    667     write(lunout, *)' fxyhypbb = ', fxyhypbb
    668     write(lunout, *)' dzoomxx = ', dzoomxx
    669     write(lunout, *)' dzoomy = ', dzoomyy
    670     write(lunout, *)' tauxx = ', tauxx
    671     write(lunout, *)' tauyy = ', tauyy
    672     write(lunout, *)' offline = ', offline
    673     write(lunout, *)' type_trac = ', type_trac
    674     write(lunout, *)' ok_dynzon = ', ok_dynzon
    675     write(lunout, *)' ok_dyn_ins = ', ok_dyn_ins
    676     write(lunout, *)' ok_dyn_ave = ', ok_dyn_ave
    677     write(lunout, *)' adv_qsat_liq = ', adv_qsat_liq
     636    WRITE(lunout, *)' #########################################'
     637    WRITE(lunout, *)' Configuration des parametres du gcm: '
     638    WRITE(lunout, *)' planet_type = ', planet_type
     639    WRITE(lunout, *)' calend = ', calend
     640    WRITE(lunout, *)' dayref = ', dayref
     641    WRITE(lunout, *)' anneeref = ', anneeref
     642    WRITE(lunout, *)' nday = ', nday
     643    WRITE(lunout, *)' day_step = ', day_step
     644    WRITE(lunout, *)' iperiod = ', iperiod
     645    WRITE(lunout, *)' nsplit_phys = ', nsplit_phys
     646    WRITE(lunout, *)' iconser = ', iconser
     647    WRITE(lunout, *)' iecri = ', iecri
     648    WRITE(lunout, *)' periodav = ', periodav
     649    WRITE(lunout, *)' output_grads_dyn = ', output_grads_dyn
     650    WRITE(lunout, *)' dissip_period = ', dissip_period
     651    WRITE(lunout, *)' lstardis = ', lstardis
     652    WRITE(lunout, *)' nitergdiv = ', nitergdiv
     653    WRITE(lunout, *)' nitergrot = ', nitergrot
     654    WRITE(lunout, *)' niterh = ', niterh
     655    WRITE(lunout, *)' tetagdiv = ', tetagdiv
     656    WRITE(lunout, *)' tetagrot = ', tetagrot
     657    WRITE(lunout, *)' tetatemp = ', tetatemp
     658    WRITE(lunout, *)' coefdis = ', coefdis
     659    WRITE(lunout, *)' purmats = ', purmats
     660    WRITE(lunout, *)' read_start = ', read_start
     661    WRITE(lunout, *)' iflag_phys = ', iflag_phys
     662    WRITE(lunout, *)' iphysiq = ', iphysiq
     663    WRITE(lunout, *)' clonn = ', clonn
     664    WRITE(lunout, *)' clatt = ', clatt
     665    WRITE(lunout, *)' grossismx = ', grossismx
     666    WRITE(lunout, *)' grossismy = ', grossismy
     667    WRITE(lunout, *)' fxyhypbb = ', fxyhypbb
     668    WRITE(lunout, *)' dzoomxx = ', dzoomxx
     669    WRITE(lunout, *)' dzoomy = ', dzoomyy
     670    WRITE(lunout, *)' tauxx = ', tauxx
     671    WRITE(lunout, *)' tauyy = ', tauyy
     672    WRITE(lunout, *)' offline = ', offline
     673    WRITE(lunout, *)' type_trac = ', type_trac
     674    WRITE(lunout, *)' ok_dynzon = ', ok_dynzon
     675    WRITE(lunout, *)' ok_dyn_ins = ', ok_dyn_ins
     676    WRITE(lunout, *)' ok_dyn_ave = ', ok_dyn_ave
     677    WRITE(lunout, *)' adv_qsat_liq = ', adv_qsat_liq
    678678  ELSE
    679679    !Config  Key  = clon
    … …  
    710710
    711711    IF(grossismx<1.)  THEN
    712       write(lunout, *) &
     712      WRITE(lunout, *) &
    713713              'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
    714714      CALL abort_gcm("conf_gcm", "stopped", 1)
    … …  
    718718
    719719    IF(grossismy<1.)  THEN
    720       write(lunout, *) 'conf_gcm: ***ATTENTION !! grossismy < 1 . *** '
     720      WRITE(lunout, *) 'conf_gcm: ***ATTENTION !! grossismy < 1 . *** '
    721721      CALL abort_gcm("conf_gcm", "stopped", 1)
    722722    ELSE
    … …  
    724724    ENDIF
    725725
    726     write(lunout, *)'conf_gcm: alphax alphay ', alphax, alphay
     726    WRITE(lunout, *)'conf_gcm: alphax alphay ', alphax, alphay
    727727
    728728    !    alphax et alphay sont les anciennes formulat. des grossissements
    … …  
    865865    CALL getin('read_orop', read_orop)
    866866
    867     write(lunout, *)' #########################################'
    868     write(lunout, *)' Configuration des parametres de cel0_limit: '
    869     write(lunout, *)' planet_type = ', planet_type
    870     write(lunout, *)' calend = ', calend
    871     write(lunout, *)' dayref = ', dayref
    872     write(lunout, *)' anneeref = ', anneeref
    873     write(lunout, *)' nday = ', nday
    874     write(lunout, *)' day_step = ', day_step
    875     write(lunout, *)' iperiod = ', iperiod
    876     write(lunout, *)' iconser = ', iconser
    877     write(lunout, *)' iecri = ', iecri
    878     write(lunout, *)' periodav = ', periodav
    879     write(lunout, *)' output_grads_dyn = ', output_grads_dyn
    880     write(lunout, *)' dissip_period = ', dissip_period
    881     write(lunout, *)' lstardis = ', lstardis
    882     write(lunout, *)' nitergdiv = ', nitergdiv
    883     write(lunout, *)' nitergrot = ', nitergrot
    884     write(lunout, *)' niterh = ', niterh
    885     write(lunout, *)' tetagdiv = ', tetagdiv
    886     write(lunout, *)' tetagrot = ', tetagrot
    887     write(lunout, *)' tetatemp = ', tetatemp
    888     write(lunout, *)' coefdis = ', coefdis
    889     write(lunout, *)' purmats = ', purmats
    890     write(lunout, *)' read_start = ', read_start
    891     write(lunout, *)' iflag_phys = ', iflag_phys
    892     write(lunout, *)' iphysiq = ', iphysiq
    893     write(lunout, *)' clon = ', clon
    894     write(lunout, *)' clat = ', clat
    895     write(lunout, *)' grossismx = ', grossismx
    896     write(lunout, *)' grossismy = ', grossismy
    897     write(lunout, *)' fxyhypb = ', fxyhypb
    898     write(lunout, *)' dzoomx = ', dzoomx
    899     write(lunout, *)' dzoomy = ', dzoomy
    900     write(lunout, *)' taux = ', taux
    901     write(lunout, *)' tauy = ', tauy
    902     write(lunout, *)' offline = ', offline
    903     write(lunout, *)' type_trac = ', type_trac
    904     write(lunout, *)' ok_dynzon = ', ok_dynzon
    905     write(lunout, *)' ok_dyn_ins = ', ok_dyn_ins
    906     write(lunout, *)' ok_dyn_ave = ', ok_dyn_ave
    907     write(lunout, *)' ok_strato = ', ok_strato
    908     write(lunout, *)' ok_gradsfile = ', ok_gradsfile
    909     write(lunout, *)' ok_limit = ', ok_limit
    910     write(lunout, *)' ok_etat0 = ', ok_etat0
    911     write(lunout, *)' ok_guide = ', ok_guide
    912     write(lunout, *)' read_orop = ', read_orop
     867    WRITE(lunout, *)' #########################################'
     868    WRITE(lunout, *)' Configuration des parametres de cel0_limit: '
     869    WRITE(lunout, *)' planet_type = ', planet_type
     870    WRITE(lunout, *)' calend = ', calend
     871    WRITE(lunout, *)' dayref = ', dayref
     872    WRITE(lunout, *)' anneeref = ', anneeref
     873    WRITE(lunout, *)' nday = ', nday
     874    WRITE(lunout, *)' day_step = ', day_step
     875    WRITE(lunout, *)' iperiod = ', iperiod
     876    WRITE(lunout, *)' iconser = ', iconser
     877    WRITE(lunout, *)' iecri = ', iecri
     878    WRITE(lunout, *)' periodav = ', periodav
     879    WRITE(lunout, *)' output_grads_dyn = ', output_grads_dyn
     880    WRITE(lunout, *)' dissip_period = ', dissip_period
     881    WRITE(lunout, *)' lstardis = ', lstardis
     882    WRITE(lunout, *)' nitergdiv = ', nitergdiv
     883    WRITE(lunout, *)' nitergrot = ', nitergrot
     884    WRITE(lunout, *)' niterh = ', niterh
     885    WRITE(lunout, *)' tetagdiv = ', tetagdiv
     886    WRITE(lunout, *)' tetagrot = ', tetagrot
     887    WRITE(lunout, *)' tetatemp = ', tetatemp
     888    WRITE(lunout, *)' coefdis = ', coefdis
     889    WRITE(lunout, *)' purmats = ', purmats
     890    WRITE(lunout, *)' read_start = ', read_start
     891    WRITE(lunout, *)' iflag_phys = ', iflag_phys
     892    WRITE(lunout, *)' iphysiq = ', iphysiq
     893    WRITE(lunout, *)' clon = ', clon
     894    WRITE(lunout, *)' clat = ', clat
     895    WRITE(lunout, *)' grossismx = ', grossismx
     896    WRITE(lunout, *)' grossismy = ', grossismy
     897    WRITE(lunout, *)' fxyhypb = ', fxyhypb
     898    WRITE(lunout, *)' dzoomx = ', dzoomx
     899    WRITE(lunout, *)' dzoomy = ', dzoomy
     900    WRITE(lunout, *)' taux = ', taux
     901    WRITE(lunout, *)' tauy = ', tauy
     902    WRITE(lunout, *)' offline = ', offline
     903    WRITE(lunout, *)' type_trac = ', type_trac
     904    WRITE(lunout, *)' ok_dynzon = ', ok_dynzon
     905    WRITE(lunout, *)' ok_dyn_ins = ', ok_dyn_ins
     906    WRITE(lunout, *)' ok_dyn_ave = ', ok_dyn_ave
     907    WRITE(lunout, *)' ok_strato = ', ok_strato
     908    WRITE(lunout, *)' ok_gradsfile = ', ok_gradsfile
     909    WRITE(lunout, *)' ok_limit = ', ok_limit
     910    WRITE(lunout, *)' ok_etat0 = ', ok_etat0
     911    WRITE(lunout, *)' ok_guide = ', ok_guide
     912    WRITE(lunout, *)' read_orop = ', read_orop
    913913  ENDIF test_etatinit
    914914

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

    r5114 r5116  
    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
    162                  write(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1'
     162                 WRITE(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1'
    163163         else
    164164          IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &

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

    r5105 r5116  
    3131
    3232  REAL :: pbarvst(iip1, jjp1, llm), zistdyn
    33   real :: dtcum
     33  REAL :: dtcum
    3434
    3535  INTEGER :: iadvtr, ndex(1)
    36   integer :: nscal
    37   real :: tst(1), ist(1), istp(1)
     36  INTEGER :: nscal
     37  REAL :: tst(1), ist(1), istp(1)
    3838  INTEGER :: ij, l, irec, i, j, itau
    3939  INTEGER, SAVE :: fluxid, fluxvid, fluxdid
    … …  
    5252  wg(:, :) = 0.
    5353
    54   if(first) then
    55 
     54  IF(first) THEN
    5655    CALL initfluxsto('fluxstoke', &
    5756            time_step, istdyn * time_step, istdyn * time_step, &
    … …  
    134133
    135134    iadvtr = 0
    136     write(lunout, *)'ITAU auquel on stoke les fluxmasses', itau
     135    WRITE(lunout, *)'ITAU auquel on stoke les fluxmasses', itau
    137136
    138137    CALL histwrite(fluxid, 'masse', itau, massem, &

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

    r5113 r5116  
    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"
    51       write(lunout, *)'Friction: wrong friction type', friction_type
     51      WRITE(lunout, *)'Friction: wrong friction type', friction_type
    5252      CALL abort_gcm(modname, abort_message, 42)
    5353    endif
    … …  
    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
    … …  
    118118  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))

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

    r5114 r5116  
    167167  !      calend = 'earth_365d'
    168168
    169   if (calend == 'earth_360d') then
     169  if (calend == 'earth_360d') THEN
    170170     CALL ioconf_calendar('360_day')
    171      write(lunout,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
    172   else if (calend == 'earth_365d') then
     171     WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
     172  else if (calend == 'earth_365d') THEN
    173173     CALL ioconf_calendar('noleap')
    174      write(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
    175   else if (calend == 'gregorian') then
     174     WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
     175  else if (calend == 'gregorian') THEN
    176176     CALL ioconf_calendar('gregorian')
    177      write(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
     177     WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
    178178  else
    179179     abort_message = 'Mauvais choix de calendrier'
    … …  
    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, &
    … …  
    216216     !        endif ! of if (planet_type.eq."earth")
    217217
    218      !       write(73,*) 'ucov',ucov
    219      !       write(74,*) 'vcov',vcov
    220      !       write(75,*) 'teta',teta
    221      !       write(76,*) 'ps',ps
    222      !       write(77,*) 'q',q
     218     !       WRITE(73,*) 'ucov',ucov
     219     !       WRITE(74,*) 'vcov',vcov
     220     !       WRITE(75,*) 'teta',teta
     221     !       WRITE(76,*) 'ps',ps
     222     !       WRITE(77,*) 'q',q
    223223
    224224  endif ! of if (read_start)
    … …  
    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
    … …  
    260260  ! on remet le calendrier \`a zero si demande
    261261
    262   IF (start_time /= starttime) then
     262  IF (start_time /= starttime) THEN
    263263     WRITE(lunout,*)' GCM: Attention l''heure de depart lue dans le' &
    264264          ,' fichier restart ne correspond pas a celle lue dans le run.def'
    265      IF (raz_date == 1) then
     265     IF (raz_date == 1) THEN
    266266        WRITE(lunout,*)'Je prends l''heure lue dans run.def'
    267267        start_time = starttime
    … …  
    277277     itau_phy = 0
    278278     time_0 = 0.
    279      write(lunout,*) &
     279     WRITE(lunout,*) &
    280280          'GCM: On reinitialise a la date lue dans gcm.def'
    281281  ELSE IF (annee_ref /= anneeref .or. day_ref /= dayref) THEN
    282      write(lunout,*) &
     282     WRITE(lunout,*) &
    283283          'GCM: Attention les dates initiales lues dans le fichier'
    284      write(lunout,*) &
     284     WRITE(lunout,*) &
    285285          ' restart ne correspondent pas a celles lues dans '
    286      write(lunout,*)' gcm.def'
    287      write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
    288      write(lunout,*)' day_ref=',day_ref," dayref=",dayref
    289      write(lunout,*)' Pas de remise a zero'
    290   ENDIF
    291 
    292   !      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
    293   !        write(lunout,*)
     286     WRITE(lunout,*)' gcm.def'
     287     WRITE(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
     288     WRITE(lunout,*)' day_ref=',day_ref," dayref=",dayref
     289     WRITE(lunout,*)' Pas de remise a zero'
     290  ENDIF
     291
     292  !      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN
     293  !        WRITE(lunout,*)
    294294  !     .  'GCM: Attention les dates initiales lues dans le fichier'
    295   !        write(lunout,*)
     295  !        WRITE(lunout,*)
    296296  !     .  ' restart ne correspondent pas a celles lues dans '
    297   !        write(lunout,*)' gcm.def'
    298   !        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
    299   !        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
    300   !        if (raz_date .ne. 1) then
    301   !          write(lunout,*)
     297  !        WRITE(lunout,*)' gcm.def'
     298  !        WRITE(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
     299  !        WRITE(lunout,*)' day_ref=',day_ref," dayref=",dayref
     300  !        if (raz_date .ne. 1) THEN
     301  !          WRITE(lunout,*)
    302302  !     .    'GCM: On garde les dates du fichier restart'
    303303  !        else
    … …  
    308308  !          itau_phy = 0
    309309  !          time_0 = 0.
    310   !          write(lunout,*)
     310  !          WRITE(lunout,*)
    311311  !     .   'GCM: On reinitialise a la date lue dans gcm.def'
    312312  !        endif
    … …  
    323323  CALL ioconf_startdate(INT(jD_ref), jH_ref)
    324324
    325   write(lunout,*)'DEBUG'
    326   write(lunout,*)'annee_ref, mois, day_ref, heure, jD_ref'
    327   write(lunout,*)annee_ref, mois, day_ref, heure, jD_ref
     325  WRITE(lunout,*)'DEBUG'
     326  WRITE(lunout,*)'annee_ref, mois, day_ref, heure, jD_ref'
     327  WRITE(lunout,*)annee_ref, mois, day_ref, heure, jD_ref
    328328  CALL ju2ymds(jD_ref+jH_ref,an, mois, jour, heure)
    329   write(lunout,*)'jD_ref+jH_ref,an, mois, jour, heure'
    330   write(lunout,*)jD_ref+jH_ref,an, mois, jour, heure
    331 
    332 
    333   if (iflag_phys==1) then
     329  WRITE(lunout,*)'jD_ref+jH_ref,an, mois, jour, heure'
     330  WRITE(lunout,*)jD_ref+jH_ref,an, mois, jour, heure
     331
     332
     333  if (iflag_phys==1) THEN
    334334     ! these initialisations have already been done (via iniacademic)
    335335     ! if running in SW or Newtonian mode
    … …  
    365365
    366366
    367   if (nday>=0) then
     367  if (nday>=0) THEN
    368368     day_end = day_ini + nday
    369369  else
    … …  
    395395  ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100))
    396396
    397   !      if (planet_type.eq."earth") then
     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
    … …  
    432432  !   ----------------------------------
    433433
    434   !       write(78,*) 'ucov',ucov
    435   !       write(78,*) 'vcov',vcov
    436   !       write(78,*) 'teta',teta
    437   !       write(78,*) 'ps',ps
    438   !       write(78,*) 'q',q
     434  !       WRITE(78,*) 'ucov',ucov
     435  !       WRITE(78,*) 'vcov',vcov
     436  !       WRITE(78,*) 'teta',teta
     437  !       WRITE(78,*) 'ps',ps
     438  !       WRITE(78,*) 'q',q
    439439
    440440

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

    r5113 r5116  
    4646    CALL getin(TARGET,ret_val)
    4747
    48     write(out_eff,*) '######################################'
    49     write(out_eff,*) '#### ',comment,' #####'
    50     write(out_eff,*) TARGET,'=',ret_val
     48    WRITE(out_eff,*) '######################################'
     49    WRITE(out_eff,*) '#### ',comment,' #####'
     50    WRITE(out_eff,*) TARGET,'=',ret_val
    5151
    5252  END SUBROUTINE getparamr
    … …  
    6969    CALL getin(TARGET,ret_val)
    7070
    71     write(out_eff,*) '######################################'
    72     write(out_eff,*) '#### ',comment,' #####'
    73     write(out_eff,*) comment
    74     write(out_eff,*) TARGET,'=',ret_val
     71    WRITE(out_eff,*) '######################################'
     72    WRITE(out_eff,*) '#### ',comment,' #####'
     73    WRITE(out_eff,*) comment
     74    WRITE(out_eff,*) TARGET,'=',ret_val
    7575
    7676  END SUBROUTINE getparami
    … …  
    9393    CALL getin(TARGET,ret_val)
    9494
    95     write(out_eff,*) '######################################'
    96     write(out_eff,*) '#### ',comment,' #####'
    97     write(out_eff,*) TARGET,'=',ret_val
     95    WRITE(out_eff,*) '######################################'
     96    WRITE(out_eff,*) '#### ',comment,' #####'
     97    WRITE(out_eff,*) TARGET,'=',ret_val
    9898
    9999  END SUBROUTINE getparaml

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

    r5113 r5116  
    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
    … …  
    2525  ! parameter (ngroup=3)
    2626
    27   real :: pbaru(iip1, jjp1, llm), pbarv(iip1, jjm, llm)
    28   real :: pext(iip1, jjp1, llm)
     27  REAL :: pbaru(iip1, jjp1, llm), pbarv(iip1, jjm, llm)
     28  REAL :: pext(iip1, jjp1, llm)
    2929
    30   real :: pbarum(iip1, jjp1, llm), pbarvm(iip1, jjm, llm)
    31   real :: wm(iip1, jjp1, llm)
     30  REAL :: pbarum(iip1, jjp1, llm), pbarvm(iip1, jjm, llm)
     31  REAL :: wm(iip1, jjp1, llm)
    3232
    33   real :: zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm)
     33  REAL :: zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm)
    3434
    35   real :: uu
     35  REAL :: uu
    3636
    37   integer :: i, j, l
     37  INTEGER :: i, j, l
    3838
    3939  logical :: firstcall, groupe_ok
    … …  
    4343  data groupe_ok/.TRUE./
    4444
    45   if (iim==1) then
     45  if (iim==1) THEN
    4646    groupe_ok = .FALSE.
    4747  endif
    4848
    49   if (firstcall) then
    50     if (groupe_ok) then
    51       if(mod(iim, 2**ngroup)/=0) &
     49  if (firstcall) THEN
     50    if (groupe_ok) THEN
     51      IF(mod(iim, 2**ngroup)/=0) &
    5252              CALL abort_gcm('groupe', 'probleme du nombre de point', 1)
    5353    endif
    … …  
    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)

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

    r5113 r5116  
    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
    … …  
    127127    IF (iguide_sav>0) THEN
    128128       iguide_sav=day_step/iguide_sav
    129     ELSE if (iguide_sav == 0) then
     129    ELSE if (iguide_sav == 0) THEN
    130130       iguide_sav = huge(0)
    131131    ELSE
    … …  
    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)
    178178          if (rcod/=nf90_noerr) THEN
    … …  
    181181          endif
    182182       endif
    183     elseif (guide_plevs==2) then
    184        if (ncidpl==-99) then
     183    elseif (guide_plevs==2) THEN
     184       if (ncidpl==-99) THEN
    185185          rcod=nf90_open('P.nc',nf90_nowrite,ncidpl)
    186186          if (rcod/=nf90_noerr) THEN
    … …  
    190190       endif
    191191
    192     elseif (guide_u) then
    193            if (ncidpl==-99) then
     192    elseif (guide_u) THEN
     193           if (ncidpl==-99) THEN
    194194               rcod=nf90_open('u.nc',nf90_nowrite,ncidpl)
    195195               if (rcod/=nf90_noerr) THEN
    … …  
    199199           endif
    200200
    201     elseif (guide_v) then
    202            if (ncidpl==-99) then
     201    elseif (guide_v) THEN
     202           if (ncidpl==-99) THEN
    203203               rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
    204204               if (rcod/=nf90_noerr) THEN
    … …  
    207207               endif
    208208           endif
    209     elseif (guide_T) then
    210            if (ncidpl==-99) then
     209    elseif (guide_T) THEN
     210           if (ncidpl==-99) THEN
    211211               rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
    212212               if (rcod/=nf90_noerr) THEN
    … …  
    215215               endif
    216216           endif
    217     elseif (guide_Q) then
    218            if (ncidpl==-99) then
     217    elseif (guide_Q) THEN
     218           if (ncidpl==-99) THEN
    219219               rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
    220220               if (rcod/=nf90_noerr) THEN
    … …  
    232232    ENDIF
    233233    error=nf90_inquire_dimension(ncidpl,rid,len=nlevnc)
    234     write(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc
     234    WRITE(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc
    235235    rcod = nf90_close(ncidpl)
    236236
    … …  
    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
    … …  
    453453      IF (reste==0.) THEN
    454454          IF (itau_test==itau) THEN
    455             write(lunout,*)trim(modname)//' second pass in advreel at itau=',&
     455            WRITE(lunout,*)trim(modname)//' second pass in advreel at itau=',&
    456456            itau
    457457              abort_message='stopped'
    … …  
    466466              step_rea=step_rea+1
    467467              itau_test=itau
    468               write(*,*)trim(modname)//' Reading nudging files, step ',&
     468              WRITE(*,*)trim(modname)//' Reading nudging files, step ',&
    469469                     step_rea,'after ',count_no_rea,' skips'
    470470              IF (guide_2D) THEN
    … …  
    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
    … …  
    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
    … …  
    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
    … …  
    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
    … …  
    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
    … …  
    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
    676676  IMPLICIT NONE
    677677
    … …  
    705705  CHARACTER(LEN=20),PARAMETER :: modname="guide_interp"
    706706 
    707     write(*,*)trim(modname)//': interpolate nudging variables'
     707    WRITE(*,*)trim(modname)//': interpolate nudging variables'
    708708! -----------------------------------------------------------------
    709709! Calcul des niveaux de pression champs guidage
    710710! -----------------------------------------------------------------
    711 IF (guide_modele) then
     711IF (guide_modele) THEN
    712712    do i=1,iip1
    713713        do j=1,jjp1
    … …  
    729729
    730730END IF
    731     if (first) then
     731    if (first) THEN
    732732        first=.FALSE.
    733         write(*,*)trim(modname)//' : check vertical level order'
    734         write(*,*)trim(modname)//' LMDZ :'
     733        WRITE(*,*)trim(modname)//' : check vertical level order'
     734        WRITE(*,*)trim(modname)//' LMDZ :'
    735735        do l=1,llm
    736           write(*,*)trim(modname)//' PL(',l,')=',(ap(l)+ap(l+1))/2. &
     736          WRITE(*,*)trim(modname)//' PL(',l,')=',(ap(l)+ap(l+1))/2. &
    737737                  +psi(1,jjp1)*(bp(l)+bp(l+1))/2.
    738738        enddo
    739         write(*,*)trim(modname)//' nudging file :'
     739        WRITE(*,*)trim(modname)//' nudging file :'
    740740        do l=1,nlevnc
    741           write(*,*)trim(modname)//' PL(',l,')=',plnc2(1,1,l)
     741          WRITE(*,*)trim(modname)//' PL(',l,')=',plnc2(1,1,l)
    742742        enddo
    743         write(*,*)trim(modname)//' invert ordering: invert_p=',invert_p
    744         if (guide_u) then
     743        WRITE(*,*)trim(modname)//' invert ordering: invert_p=',invert_p
     744        if (guide_u) THEN
    745745            do l=1,nlevnc
    746               write(*,*)trim(modname)//' U(',l,')=',unat2(1,1,l)
     746              WRITE(*,*)trim(modname)//' U(',l,')=',unat2(1,1,l)
    747747            enddo
    748748        endif
    749         if (guide_T) then
     749        if (guide_T) THEN
    750750            do l=1,nlevnc
    751               write(*,*)trim(modname)//' T(',l,')=',tnat2(1,1,l)
     751              WRITE(*,*)trim(modname)//' T(',l,')=',tnat2(1,1,l)
    752752            enddo
    753753        endif
    … …  
    758758! -----------------------------------------------------------------
    759759    CALL pression( ip1jmp1, ap, bp, psi, p )
    760     if (pressure_exner) then
     760    if (pressure_exner) THEN
    761761      CALL exner_hyb(ip1jmp1,psi,p,pks,pk)
    762762    else
    … …  
    803803! Conversion en variables gcm (ucov, vcov...)
    804804! -----------------------------------------------------------------
    805     if (guide_P) then
     805    if (guide_P) THEN
    806806        do j=1,jjp1
    807807            do i=1,iim
    … …  
    921921! Calcul des constantes de rappel alpha (=1/tau)
    922922
    923     use comconst_mod, only: pi
    924     use serre_mod, only: clon, clat, grossismx, grossismy
     923    use comconst_mod, ONLY: pi
     924    use serre_mod, ONLY: clon, clat, grossismx, grossismy
    925925   
    926926    IMPLICIT NONE
    … …  
    948948    real alphamin,alphamax,xi
    949949    integer i,j,ilon,ilat
    950     character(len=20),parameter :: modname="tau2alpha"
     950    CHARACTER(LEN=20),parameter :: modname="tau2alpha"
    951951    CHARACTER (len = 80)   :: abort_message
    952952
    … …  
    962962            do j=1,pjm
    963963                do i=1,pim
    964                     if (typ==2) then
     964                    if (typ==2) THEN
    965965                       zlat=rlatu(j)*180./pi
    966966                       zlon=rlonu(i)*180./pi
    967                     elseif (typ==1) then
     967                    elseif (typ==1) THEN
    968968                       zlat=rlatu(j)*180./pi
    969969                       zlon=rlonv(i)*180./pi
    970                     elseif (typ==3) then
     970                    elseif (typ==3) THEN
    971971                       zlat=rlatv(j)*180./pi
    972972                       zlon=rlonv(i)*180./pi
    … …  
    10371037            enddo
    10381038            ! Calcul de gamma
    1039             if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) then
    1040               write(*,*)trim(modname)//' ATTENTION modele peu zoome'
    1041               write(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste'
     1039            if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) THEN
     1040              WRITE(*,*)trim(modname)//' ATTENTION modele peu zoome'
     1041              WRITE(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste'
    10421042              gamma=0.
    10431043            else
    10441044              gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
    1045               write(*,*)trim(modname)//' gamma=',gamma
    1046               if (gamma<1.e-5) then
    1047                 write(*,*)trim(modname)//' gamma =',gamma,'<1e-5'
     1045              WRITE(*,*)trim(modname)//' gamma=',gamma
     1046              if (gamma<1.e-5) THEN
     1047                WRITE(*,*)trim(modname)//' gamma =',gamma,'<1e-5'
    10481048                abort_message='stopped'
    10491049                CALL abort_gcm(modname,abort_message,1)
    10501050              endif
    10511051              gamma=log(0.5)/log(gamma)
    1052               if (gamma4) then
     1052              if (gamma4) THEN
    10531053                gamma=min(gamma,4.)
    10541054              endif
    1055               write(*,*)trim(modname)//' gamma=',gamma
     1055              WRITE(*,*)trim(modname)//' gamma=',gamma
    10561056            endif
    10571057        ENDIF !first
    … …  
    10591059        do j=1,pjm
    10601060            do i=1,pim
    1061                 if (typ==1) then
     1061                if (typ==1) THEN
    10621062                   dxdy_=dxdys(i,j)
    10631063                   zlat=rlatu(j)*180./pi
    1064                 elseif (typ==2) then
     1064                elseif (typ==2) THEN
    10651065                   dxdy_=dxdyu(i,j)
    10661066                   zlat=rlatu(j)*180./pi
    1067                 elseif (typ==3) then
     1067                elseif (typ==3) THEN
    10681068                   dxdy_=dxdyv(i,j)
    10691069                   zlat=rlatv(j)*180./pi
    10701070                endif
    1071                 if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) then
     1071                if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) THEN
    10721072                ! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin
    10731073                    alpha(i,j)=alphamin
    … …  
    10751075                    xi=((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma
    10761076                    xi=min(xi,1.)
    1077                     if(lat_min_g<=zlat .and. zlat<=lat_max_g) then
     1077                    IF(lat_min_g<=zlat .and. zlat<=lat_max_g) THEN
    10781078                        alpha(i,j)=xi*alphamin+(1.-xi)*alphamax
    10791079                    else
    … …  
    11131113! Premier appel: initialisation de la lecture des fichiers
    11141114! -----------------------------------------------------------------
    1115     if (first) then
     1115    if (first) THEN
    11161116         ncidpl=-99
    1117          write(*,*) trim(modname)//': opening nudging files '
     1117         WRITE(*,*) trim(modname)//': opening nudging files '
    11181118! Niveaux de pression si non constants
    1119          if (guide_plevs==1) then
    1120              write(*,*) trim(modname)//' Reading nudging on model levels'
     1119         if (guide_plevs==1) THEN
     1120             WRITE(*,*) trim(modname)//' Reading nudging on model levels'
    11211121             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    11221122             IF (rcode/=nf90_noerr) THEN
    … …  
    11341134              CALL abort_gcm(modname,abort_message,1)
    11351135             ENDIF
    1136              write(*,*) trim(modname)//' ncidpl,varidap',ncidpl,varidap
     1136             WRITE(*,*) trim(modname)//' ncidpl,varidap',ncidpl,varidap
    11371137         endif
    11381138
    11391139! Pression si guidage sur niveaux P variables
    1140          if (guide_plevs==2) then
     1140         if (guide_plevs==2) THEN
    11411141             rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
    11421142             IF (rcode/=nf90_noerr) THEN
    … …  
    11491149              CALL abort_gcm(modname,abort_message,1)
    11501150             ENDIF
    1151              write(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp
     1151             WRITE(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp
    11521152             if (ncidpl==-99) ncidpl=ncidp
    11531153         endif
    11541154
    11551155! Vent zonal
    1156          if (guide_u) then
     1156         if (guide_u) THEN
    11571157             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    11581158             IF (rcode/=nf90_noerr) THEN
    … …  
    11651165              CALL abort_gcm(modname,abort_message,1)
    11661166             ENDIF
    1167              write(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu
     1167             WRITE(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu
    11681168             if (ncidpl==-99) ncidpl=ncidu
    11691169
    … …  
    11851185
    11861186! Vent meridien
    1187          if (guide_v) then
     1187         if (guide_v) THEN
    11881188             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    11891189             IF (rcode/=nf90_noerr) THEN
    … …  
    11961196              CALL abort_gcm(modname,abort_message,1)
    11971197             ENDIF
    1198              write(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv
     1198             WRITE(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv
    11991199             if (ncidpl==-99) ncidpl=ncidv
    12001200             
    … …  
    12181218
    12191219! Temperature
    1220          if (guide_T) then
     1220         if (guide_T) THEN
    12211221             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    12221222             IF (rcode/=nf90_noerr) THEN
    … …  
    12291229              CALL abort_gcm(modname,abort_message,1)
    12301230             ENDIF
    1231              write(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt
     1231             WRITE(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt
    12321232             if (ncidpl==-99) ncidpl=ncidt
    12331233
    … …  
    12491249
    12501250! Humidite
    1251          if (guide_Q) then
     1251         if (guide_Q) THEN
    12521252             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    12531253             IF (rcode/=nf90_noerr) THEN
    … …  
    12601260              CALL abort_gcm(modname,abort_message,1)
    12611261             ENDIF
    1262              write(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
     1262             WRITE(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
    12631263             if (ncidpl==-99) ncidpl=ncidQ
    12641264
    … …  
    12801280
    12811281! Pression de surface
    1282          if ((guide_P).OR.(guide_modele)) then
     1282         if ((guide_P).OR.(guide_modele)) THEN
    12831283             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    12841284             IF (rcode/=nf90_noerr) THEN
    … …  
    12911291              CALL abort_gcm(modname,abort_message,1)
    12921292             ENDIF
    1293              write(*,*) trim(modname)//' ncidps,varidps',ncidps,varidps
     1293             WRITE(*,*) trim(modname)//' ncidps,varidps',ncidps,varidps
    12941294         endif
    12951295! Coordonnee verticale
    1296          if (guide_plevs==0) then
     1296         if (guide_plevs==0) THEN
    12971297              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    12981298              IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    1299               write(*,*) trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
     1299              WRITE(*,*) trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    13001300         endif
    13011301! Coefs ap, bp pour calcul de la pression aux differents niveaux
    1302          if (guide_plevs==1) then
     1302         if (guide_plevs==1) THEN
    13031303             status=nf90_get_var(ncidpl,varidap,apnc,[1],[nlevnc])
    13041304             status=nf90_get_var(ncidpl,varidbp,bpnc,[1],[nlevnc])
    … …  
    13281328
    13291329! Pression
    1330      if (guide_plevs==2) then
     1330     if (guide_plevs==2) THEN
    13311331         status=nf90_get_var(ncidp,varidp,pnat2,start,count)
    13321332         IF (invert_y) THEN
    … …  
    13381338
    13391339!  Vent zonal
    1340      if (guide_u) then
     1340     if (guide_u) THEN
    13411341         status=nf90_get_var(ncidu,varidu,unat2,start,count)
    13421342         IF (invert_y) THEN
    … …  
    13461346
    13471347!  Temperature
    1348      if (guide_T) then
     1348     if (guide_T) THEN
    13491349         status=nf90_get_var(ncidt,varidt,tnat2,start,count)
    13501350         IF (invert_y) THEN
    … …  
    13541354
    13551355!  Humidite
    1356      if (guide_Q) then
     1356     if (guide_Q) THEN
    13571357         status=nf90_get_var(ncidQ,varidQ,qnat2,start,count)
    13581358         IF (invert_y) THEN
    … …  
    13631363
    13641364!  Vent meridien
    1365      if (guide_v) then
     1365     if (guide_v) THEN
    13661366         count(2)=jjm
    13671367         status=nf90_get_var(ncidv,varidv,vnat2,start,count)
    … …  
    13721372
    13731373!  Pression de surface
    1374      if ((guide_P).OR.(guide_modele))  then
     1374     if ((guide_P).OR.(guide_modele))  THEN
    13751375         start(3)=timestep
    13761376         start(4)=0
    … …  
    14131413! Premier appel: initialisation de la lecture des fichiers
    14141414! -----------------------------------------------------------------
    1415     if (first) then
     1415    if (first) THEN
    14161416         ncidpl=-99
    1417          write(*,*)trim(modname)//' : opening nudging files '
     1417         WRITE(*,*)trim(modname)//' : opening nudging files '
    14181418! Ap et Bp si niveaux de pression hybrides
    1419          if (guide_plevs==1) then
    1420            write(*,*)trim(modname)//' Reading nudging on model levels'
     1419         if (guide_plevs==1) THEN
     1420           WRITE(*,*)trim(modname)//' Reading nudging on model levels'
    14211421           rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    14221422           IF (rcode/=nf90_noerr) THEN
    … …  
    14341434             CALL abort_gcm(modname,abort_message,1)
    14351435           ENDIF
    1436            write(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap
     1436           WRITE(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap
    14371437         endif
    14381438! Pression
    1439          if (guide_plevs==2) then
     1439         if (guide_plevs==2) THEN
    14401440           rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
    14411441           IF (rcode/=nf90_noerr) THEN
    … …  
    14481448             CALL abort_gcm(modname,abort_message,1)
    14491449           ENDIF
    1450            write(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
     1450           WRITE(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
    14511451           if (ncidpl==-99) ncidpl=ncidp
    14521452         endif
    14531453! Vent zonal
    1454          if (guide_u) then
     1454         if (guide_u) THEN
    14551455           rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    14561456           IF (rcode/=nf90_noerr) THEN
    … …  
    14631463             CALL abort_gcm(modname,abort_message,1)
    14641464           ENDIF
    1465            write(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
     1465           WRITE(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
    14661466           if (ncidpl==-99) ncidpl=ncidu
    14671467         endif
    14681468! Vent meridien
    1469          if (guide_v) then
     1469         if (guide_v) THEN
    14701470           rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    14711471           IF (rcode/=nf90_noerr) THEN
    … …  
    14781478             CALL abort_gcm(modname,abort_message,1)
    14791479           ENDIF
    1480            write(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
     1480           WRITE(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
    14811481           if (ncidpl==-99) ncidpl=ncidv
    14821482         endif
    14831483! Temperature
    1484          if (guide_T) then
     1484         if (guide_T) THEN
    14851485           rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    14861486           IF (rcode/=nf90_noerr) THEN
    … …  
    14931493             CALL abort_gcm(modname,abort_message,1)
    14941494           ENDIF
    1495            write(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
     1495           WRITE(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
    14961496           if (ncidpl==-99) ncidpl=ncidt
    14971497         endif
    14981498! Humidite
    1499          if (guide_Q) then
     1499         if (guide_Q) THEN
    15001500           rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    15011501           IF (rcode/=nf90_noerr) THEN
    … …  
    15081508             CALL abort_gcm(modname,abort_message,1)
    15091509           ENDIF
    1510            write(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
     1510           WRITE(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
    15111511           if (ncidpl==-99) ncidpl=ncidQ
    15121512         endif
    15131513! Pression de surface
    1514          if ((guide_P).OR.(guide_modele)) then
     1514         if ((guide_P).OR.(guide_modele)) THEN
    15151515           rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    15161516           IF (rcode/=nf90_noerr) THEN
    … …  
    15231523             CALL abort_gcm(modname,abort_message,1)
    15241524           ENDIF
    1525            write(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps
     1525           WRITE(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps
    15261526         endif
    15271527! Coordonnee verticale
    1528          if (guide_plevs==0) then
     1528         if (guide_plevs==0) THEN
    15291529           rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    15301530           IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    1531            write(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
     1531           WRITE(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    15321532         endif
    15331533! Coefs ap, bp pour calcul de la pression aux differents niveaux
    1534          if (guide_plevs==1) then
     1534         if (guide_plevs==1) THEN
    15351535             status=nf90_get_var(ncidpl,varidap,apnc,[1],[nlevnc])
    15361536             status=nf90_get_var(ncidpl,varidbp,bpnc,[1],[nlevnc])
    … …  
    15591559
    15601560!  Pression
    1561      if (guide_plevs==2) then
     1561     if (guide_plevs==2) THEN
    15621562         status=nf90_get_var(ncidp,varidp,zu,start,count)
    15631563         DO i=1,iip1
    … …  
    15721572     endif
    15731573!  Vent zonal
    1574      if (guide_u) then
     1574     if (guide_u) THEN
    15751575         status=nf90_get_var(ncidu,varidu,zu,start,count)
    15761576         DO i=1,iip1
    … …  
    15851585
    15861586!  Temperature
    1587      if (guide_T) then
     1587     if (guide_T) THEN
    15881588         status=nf90_get_var(ncidt,varidt,zu,start,count)
    15891589         DO i=1,iip1
    … …  
    15981598
    15991599!  Humidite
    1600      if (guide_Q) then
     1600     if (guide_Q) THEN
    16011601         status=nf90_get_var(ncidQ,varidQ,zu,start,count)
    16021602         DO i=1,iip1
    … …  
    16111611
    16121612!  Vent meridien
    1613      if (guide_v) then
     1613     if (guide_v) THEN
    16141614         count(2)=jjm
    16151615         status=nf90_get_var(ncidv,varidv,zv,start,count)
    … …  
    16251625
    16261626!  Pression de surface
    1627      if ((guide_P).OR.(guide_plevs==1))  then
     1627     if ((guide_P).OR.(guide_plevs==1))  THEN
    16281628         start(3)=timestep
    16291629         start(4)=0
    … …  
    16741674    CHARACTER(LEN=20),PARAMETER :: modname="guide_out"
    16751675
    1676     write(*,*)trim(modname)//': output timestep',timestep,'var ',varname
     1676    WRITE(*,*)trim(modname)//': output timestep',timestep,'var ',varname
    16771677    IF (timestep==0) THEN
    16781678! ----------------------------------------------
    … …  
    18041804    do l=1,nl
    18051805        do i=2,iim-1
    1806             if(abs(x(i,l))>1.e10) then
     1806            IF(abs(x(i,l))>1.e10) THEN
    18071807               zz=0.5*(x(i-1,l)+x(i+1,l))
    18081808              PRINT*,'correction ',i,l,x(i,l),zz

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

    r5106 r5116  
    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
    1212  USE Write_Field
    … …  
    6060  INTEGER i,j,l,lsup,ij, iq, iName, iPhase, iqParent
    6161
    62   integer :: nid_relief,varid,ierr
     62  INTEGER :: nid_relief,varid,ierr
    6363  real, dimension(iip1,jjp1) :: relief
    6464
    … …  
    7575  LOGICAL,PARAMETER :: tnat1=.TRUE.
    7676 
    77   character(len=*),parameter :: modname="iniacademic"
    78   character(len=80) :: abort_message
     77  CHARACTER(LEN=*),parameter :: modname="iniacademic"
     78  CHARACTER(LEN=80) :: abort_message
    7979
    8080  ! Sanity check: verify that options selected by user are not incompatible
    81   if ((iflag_phys==1).and. .not. read_start) then
    82     write(lunout,*) trim(modname)," error: if read_start is set to ", &
     81  if ((iflag_phys==1).and. .not. read_start) THEN
     82    WRITE(lunout,*) trim(modname)," error: if read_start is set to ", &
    8383    " false then iflag_phys should not be 1"
    84     write(lunout,*) "You most likely want an aquaplanet initialisation", &
     84    WRITE(lunout,*) "You most likely want an aquaplanet initialisation", &
    8585    " (iflag_phys >= 100)"
    8686    CALL abort_gcm(modname,"incompatible iflag_phys==1 and read_start==.FALSE.",1)
    … …  
    109109  ang0       = 0.
    110110
    111   if (llm == 1) then
     111  if (llm == 1) THEN
    112112     ! specific initializations for the shallow water case
    113113     kappa=1
    … …  
    164164     CALL pression ( ip1jmp1, ap, bp, ps, p       )
    165165
    166      if (pressure_exner) then
     166     if (pressure_exner) THEN
    167167       CALL exner_hyb( ip1jmp1, ps, p, pks, pk)
    168168     else
    … …  
    172172  ENDIF
    173173
    174   if (llm == 1) then
     174  if (llm == 1) THEN
    175175     ! initialize fields for the shallow water case, if required
    176      if (.not.read_start) then
     176     if (.not.read_start) THEN
    177177        phis(:)=0.
    178178        q(:,:,:)=0
    … …  
    181181  endif
    182182
    183   academic_case: if (iflag_phys >= 2) then
     183  academic_case: if (iflag_phys >= 2) THEN
    184184     ! initializations
    185185
    … …  
    249249           tetajl(j,l)=teta0-delt_y*ddsin*ddsin+eps*ddsin &
    250250                -delt_z*(1.-ddsin*ddsin)*log(zsig)
    251            if (planet_type=="giant") then
     251           if (planet_type=="giant") THEN
    252252             tetajl(j,l)=teta0+(delt_y*                   &
    253253                ((sin(rlatu(j)*3.14159*eps+0.0001))**2)   &
    … …  
    293293
    294294        ! winds
    295         if (ok_geost) then
     295        if (ok_geost) THEN
    296296           CALL ugeostr(phi,ucov)
    297297        else
    … …  
    301301
    302302        ! bulk initialization of tracers
    303         if (planet_type=="earth") then
     303        if (planet_type=="earth") THEN
    304304           ! Earth: first two tracers will be water
    305305           do iq=1,nqtot
    … …  
    315315              iqParent = tracers(iq)%iqParent
    316316              IF(tracers(iq)%iso_iZone == 0) THEN
    317                  if (tnat1) then
     317                 if (tnat1) THEN
    318318                         tnat=1.0
    319319                         alpha_ideal=1.0
    320                          write(*,*) 'Attention dans iniacademic: alpha_ideal=1'
     320                         WRITE(*,*) 'Attention dans iniacademic: alpha_ideal=1'
    321321                 else
    322322                    IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &

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

    r5113 r5116  
    3232  !  """""""""
    3333  ! INPUT
    34   integer :: imo, jmo ! dimensions ancienne grille
    35   integer :: imn, jmn  ! dimensions nouvelle grille
    36   integer :: kllm ! taille du tableau des intersections
    37   real :: rlonuo(imo + 1)     !  Latitude et
    38   real :: rlatvo(jmo)       !  longitude des
    39   real :: rlonun(imn + 1)     !  bord des
    40   real :: rlatvn(jmn)     !  cases "scalaires" (input)
     34  INTEGER :: imo, jmo ! dimensions ancienne grille
     35  INTEGER :: imn, jmn  ! dimensions nouvelle grille
     36  INTEGER :: kllm ! taille du tableau des intersections
     37  REAL :: rlonuo(imo + 1)     !  Latitude et
     38  REAL :: rlatvo(jmo)       !  longitude des
     39  REAL :: rlonun(imn + 1)     !  bord des
     40  REAL :: rlatvn(jmn)     !  cases "scalaires" (input)
    4141
    4242  ! OUTPUT
    43   integer :: ktotal ! nombre totale d'intersections reperees
    44   integer :: iik(kllm), jjk(kllm), jk(kllm), ik(kllm)
    45   real :: intersec(kllm)  ! surface des intersections (m2)
    46   real :: airen (imn + 1, jmn + 1) ! aire dans la nouvelle grille
     43  INTEGER :: ktotal ! nombre totale d'intersections reperees
     44  INTEGER :: iik(kllm), jjk(kllm), jk(kllm), ik(kllm)
     45  REAL :: intersec(kllm)  ! surface des intersections (m2)
     46  REAL :: airen (imn + 1, jmn + 1) ! aire dans la nouvelle grille
    4747
    4848
    … …  
    5151  ! Autres variables
    5252  ! """"""""""""""""
    53   integer :: i, j, ii, jj, k
    54   real :: a(imo + 1), b(imo + 1), c(jmo + 1), d(jmo + 1)
    55   real :: an(imn + 1), bn(imn + 1), cn(jmn + 1), dn(jmn + 1)
    56   real :: aa, bb, cc, dd
    57   real :: pi
     53  INTEGER :: i, j, ii, jj, k
     54  REAL :: a(imo + 1), b(imo + 1), c(jmo + 1), d(jmo + 1)
     55  REAL :: an(imn + 1), bn(imn + 1), cn(jmn + 1), dn(jmn + 1)
     56  REAL :: aa, bb, cc, dd
     57  REAL :: pi
    5858
    5959  pi = 2. * ASIN(1.)
    … …  
    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
    … …  
    124124                    .or. ((an(ii)<b(i) + 2 * pi).and.(bn(ii)>a(i) + 2 * pi) &
    125125                            .and.(a(i) + 2 * pi>pi)) &
    126                     )then
     126                    )THEN
    127127              ktotal = ktotal + 1
    128128              iik(ktotal) = ii
    … …  
    135135              if (cc< c(j))cc = c(j)
    136136              if((an(ii)<b(i) - 2 * pi).and. &
    137                       (bn(ii)>a(i) - 2 * pi)) then
     137                      (bn(ii)>a(i) - 2 * pi)) THEN
    138138                bb = min(b(i) - 2 * pi, bn(ii))
    139139                aa = an(ii)
    140140                if (aa<a(i) - 2 * pi) aa = a(i) - 2 * pi
    141141              else if((an(ii)<b(i) + 2 * pi).and. &
    142                       (bn(ii)>a(i) + 2 * pi)) then
     142                      (bn(ii)>a(i) + 2 * pi)) THEN
    143143                bb = min(b(i) + 2 * pi, bn(ii))
    144144                aa = an(ii)
    … …  
    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
    169   !      write(*,*) '**************** jj=',jj,'ii=',ii
    170   !      write(*,*) 'i,j =',i,j
    171   !      write(*,*) 'an,bn,cn,dn', an(ii), bn(ii), cn(jj),dn(jj)
    172   !      write(*,*) 'a,b,c,d', a(i), b(i), c(j),d(j)
    173   !      write(*,*) 'intersec(k)',intersec(k)
    174   !      write(*,*) 'airen(ii,jj)=',airen(ii,jj)
     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
     169  !      WRITE(*,*) '**************** jj=',jj,'ii=',ii
     170  !      WRITE(*,*) 'i,j =',i,j
     171  !      WRITE(*,*) 'an,bn,cn,dn', an(ii), bn(ii), cn(jj),dn(jj)
     172  !      WRITE(*,*) 'a,b,c,d', a(i), b(i), c(j),d(j)
     173  !      WRITE(*,*) 'intersec(k)',intersec(k)
     174  !      WRITE(*,*) 'airen(ii,jj)=',airen(ii,jj)
    175175  !  end if
    176176  ! END DO

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

    r5113 r5116  
    77
    88  use control_mod, ONLY: planet_type
    9   use comconst_mod, only: pi
     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
    … …  
    9898  DO ij = 1, ip1jmp1
    9999    IF(ps(ij)<0.) THEN
    100       write(lunout, *) "integrd: negative surface pressure ", ps(ij)
    101       write(lunout, *) " at node ij =", ij
     100      WRITE(lunout, *) "integrd: negative surface pressure ", ps(ij)
     101      WRITE(lunout, *) " at node ij =", ij
    102102      ! since ij=j+(i-1)*jjp1 , we have
    103103      j = modulo(ij, jjp1)
    104104      i = 1 + (ij - j) / jjp1
    105       write(lunout, *) " lon = ", rlonv(i) * 180. / pi, " deg", &
     105      WRITE(lunout, *) " lon = ", rlonv(i) * 180. / pi, " deg", &
    106106              " lat = ", rlatu(j) * 180. / pi, " deg"
    107107      CALL abort_gcm("integrd", "", 1)
    … …  
    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

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

    r5106 r5116  
    2222  !  """""""""
    2323
    24   integer :: imo, jmo ! dimensions ancienne grille (input)
    25   integer :: imn, jmn  ! dimensions nouvelle grille (input)
     24  INTEGER :: imo, jmo ! dimensions ancienne grille (input)
     25  INTEGER :: imn, jmn  ! dimensions nouvelle grille (input)
    2626
    27   real :: rlonuo(imo + 1)     !  Latitude et
    28   real :: rlatvo(jmo)       !  longitude des
    29   real :: rlonun(imn + 1)     !  bord des
    30   real :: rlatvn(jmn)     !  cases "scalaires" (input)
     27  REAL :: rlonuo(imo + 1)     !  Latitude et
     28  REAL :: rlatvo(jmo)       !  longitude des
     29  REAL :: rlonun(imn + 1)     !  bord des
     30  REAL :: rlatvn(jmn)     !  cases "scalaires" (input)
    3131
    32   integer :: lm ! dimension verticale (input)
    33   real :: varo (imo + 1, jmo + 1, lm) ! var dans l'ancienne grille (input)
    34   real :: varn (imn + 1, jmn + 1, lm) ! var dans la nouvelle grille (output)
     32  INTEGER :: lm ! dimension verticale (input)
     33  REAL :: varo (imo + 1, jmo + 1, lm) ! var dans l'ancienne grille (input)
     34  REAL :: varn (imn + 1, jmn + 1, lm) ! var dans la nouvelle grille (output)
    3535
    3636  ! Autres variables
    3737  ! """"""""""""""""
    38   real :: airetest(imn + 1, jmn + 1)
    39   integer :: ii, jj, l
     38  REAL :: airetest(imn + 1, jmn + 1)
     39  INTEGER :: ii, jj, l
    4040
    41   real :: airen (imn + 1, jmn + 1) ! aire dans la nouvelle grille
     41  REAL :: airen (imn + 1, jmn + 1) ! aire dans la nouvelle grille
    4242  !    Info sur les ktotal intersection entre les cases new/old grille
    43   integer :: kllm, k, ktotal
     43  INTEGER :: kllm, k, ktotal
    4444  parameter (kllm = 400 * 200 * 10)
    45   integer :: iik(kllm), jjk(kllm), jk(kllm), ik(kllm)
    46   real :: intersec(kllm)
    47   real :: R
    48   real :: totn, tots
     45  INTEGER :: iik(kllm), jjk(kllm), jk(kllm), ik(kllm)
     46  REAL :: intersec(kllm)
     47  REAL :: R
     48  REAL :: totn, tots
    4949
    5050  logical :: firstcall, firsttest, aire_ok
    … …  
    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'
    133   !! !             write(*,*)'ii,jj,airen,airetest',
     133  !! !             WRITE(*,*)'ii,jj,airen,airetest',
    134134  !! !     &          ii,jj,airen(ii,jj),airetest(ii,jj)
    135135  !!              aire_ok = .FALSE.
    … …  
    137137  !!        END DO
    138138  !!       END DO
    139   !! !      if (aire_ok) write(*,*) 'INTERP. HORIZ. : AIRES OK'
     139  !! !      if (aire_ok) WRITE(*,*) 'INTERP. HORIZ. : AIRES OK'
    140140  !!  99   continue
    141141

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

    r5114 r5116  
    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
    … …  
    8585  REAL :: w(ip1jmp1, llm)                    ! vertical velocity
    8686
    87   real :: zqmin, zqmax
     87  REAL :: zqmin, zqmax
    8888
    8989  ! variables dynamiques intermediaire pour le transport
    … …  
    124124  INTEGER :: ik
    125125
    126   real :: time_step, t_wrt, t_ops
     126  REAL :: time_step, t_wrt, t_ops
    127127
    128128  ! REAL rdayvrai,rdaym_ini
    … …  
    137137  save first
    138138  data first/.TRUE./
    139   real :: dt_cum
    140   character(len = 10) :: infile
    141   integer :: zan, tau0, thoriid
    142   integer :: nid_ctesGCM
     139  REAL :: dt_cum
     140  CHARACTER(LEN = 10) :: infile
     141  INTEGER :: zan, tau0, thoriid
     142  INTEGER :: nid_ctesGCM
    143143  save nid_ctesGCM
    144   real :: degres
    145   real :: rlong(iip1), rlatg(jjp1)
    146   real :: zx_tmp_2d(iip1, jjp1)
    147   integer :: ndex2d(iip1 * jjp1)
     144  REAL :: degres
     145  REAL :: rlong(iip1), rlatg(jjp1)
     146  REAL :: zx_tmp_2d(iip1, jjp1)
     147  INTEGER :: ndex2d(iip1 * jjp1)
    148148  logical :: ok_sync
    149149  parameter (ok_sync = .TRUE.)
    … …  
    151151
    152152  data callinigrads/.TRUE./
    153   character(len = 10) :: string10
     153  CHARACTER(LEN = 10) :: string10
    154154
    155155  REAL :: flxw(ip1jmp1, llm)  ! flux de masse verticale
    … …  
    170170  !-jld
    171171
    172   character(len = 80) :: dynhist_file, dynhistave_file
    173   character(len = *), parameter :: modname = "leapfrog"
    174   character(len = 80) :: abort_message
     172  CHARACTER(LEN = 80) :: dynhist_file, dynhistave_file
     173  CHARACTER(LEN = *), parameter :: modname = "leapfrog"
     174  CHARACTER(LEN = 80) :: abort_message
    175175
    176176  logical :: dissip_conservative
    … …  
    186186  logical, parameter :: flag_verif = .FALSE.
    187187
    188   integer :: itau_w   ! pas de temps ecriture = itap + itau_phy
    189 
    190   if (nday>=0) then
     188  INTEGER :: itau_w   ! pas de temps ecriture = itap + itau_phy
     189
     190  if (nday>=0) THEN
    191191    itaufin = nday * day_step
    192192  else
    … …  
    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
    … …  
    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)
    240240  endif
    … …  
    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.
    314314  endif
    … …  
    341341            p, masse, dq, teta, &
    342342            flxw, pk)
    343     !write(*,*) 'caladvtrac 346'
     343    !WRITE(*,*) 'caladvtrac 346'
    344344
    345345    IF (offline) THEN
    … …  
    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
    … …  
    417417    jD_cur = jD_cur + int(jH_cur)
    418418    jH_cur = jH_cur - int(jH_cur)
    419     ! write(lunout,*)'itau, jD_cur = ', itau, jD_cur, jH_cur
     419    ! WRITE(lunout,*)'itau, jD_cur = ', itau, jD_cur, jH_cur
    420420    ! CALL ju2ymds(jD_cur+jH_cur, an, mois, jour, secondes)
    421     ! write(lunout,*)'current date = ',an, mois, jour, secondes
     421    ! WRITE(lunout,*)'current date = ',an, mois, jour, secondes
    422422
    423423    ! rajout debug
    … …  
    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
    … …  
    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
    … …  
    590590
    591591  ! ajout debug
    592   ! IF( lafin ) then
     592  ! IF( lafin ) THEN
    593593  !   abort_message = 'Simulation finished'
    594594  !   CALL abort_gcm(modname,abort_message,0)
    … …  
    620620    ENDIF
    621621
    622     IF(itau == itaufinp1) then
    623       if (flag_verif) then
    624         write(79, *) 'ucov', ucov
    625         write(80, *) 'vcov', vcov
    626         write(81, *) 'teta', teta
    627         write(82, *) 'ps', ps
    628         write(83, *) 'q', q
     622    IF(itau == itaufinp1) THEN
     623      if (flag_verif) THEN
     624        WRITE(79, *) 'ucov', ucov
     625        WRITE(80, *) 'vcov', vcov
     626        WRITE(81, *) 'teta', teta
     627        WRITE(82, *) 'ps', ps
     628        WRITE(83, *) 'q', q
    629629        WRITE(85, *) 'q1 = ', q(:, :, 1)
    630630        WRITE(86, *) 'q3 = ', q(:, :, 3)
    … …  
    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
    678             ! write(lunout,*) "leapfrog: CALL writehist, itau=",itau
     677          if (ok_dyn_ins) THEN
     678            ! WRITE(lunout,*) "leapfrog: CALL writehist, itau=",itau
    679679           CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis)
    680680            ! CALL WriteField('ucov',reshape(ucov,(/iip1,jmp1,llm/)))
    … …  
    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
    … …  
    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, &
    … …  
    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
    … …  
    760760
    761761      forward = .FALSE.
    762       IF(itau == itaufinp1) then
     762      IF(itau == itaufinp1) THEN
    763763        abort_message = 'Simulation finished'
    764764        CALL abort_gcm(modname, abort_message, 0)
    … …  
    799799          vnat(:, l) = vcov(:, l) / cv(:)
    800800        enddo
    801           if (ok_dyn_ins) then
    802              ! write(lunout,*) "leapfrog: CALL writehist (b)",
     801          if (ok_dyn_ins) THEN
     802             ! WRITE(lunout,*) "leapfrog: CALL writehist (b)",
    803803  ! &                        itau,iecri
    804804            CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis)
    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)
    817817        ! endif ! of if (planet_type.eq."earth")
    818         if (ok_guide) then
     818        if (ok_guide) THEN
    819819          ! ! set ok_guide to false to avoid extra output
    820820          ! ! in following forward step

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

    r5113 r5116  
    3333  REAL :: zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
    3434
    35   real :: zx_defau_diag(ip1jmp1, llm, 2)
    36   real :: q_follow(ip1jmp1, llm, 2)
     35  REAL :: zx_defau_diag(ip1jmp1, llm, 2)
     36  REAL :: q_follow(ip1jmp1, llm, 2)
    3737  !
    3838  REAL :: SSUM
    … …  
    6464  DO k = 1, llm
    6565    DO i = 1, ip1jmp1
    66       if (seuil_liq - q(i, k, iq_liq) > 0.d0) then
    67 
     66      if (seuil_liq - q(i, k, iq_liq) > 0.d0) THEN
    6867        if (niso > 0) zx_defau_diag(i, k, 2) = AMAX1 &
    6968                (seuil_liq - q(i, k, iq_liq), 0.0)
    … …  
    8180    !cc      zx_abc = dpres(k) / dpres(k-1)
    8281    DO i = 1, ip1jmp1
    83       if (seuil_vap - q(i, k, iq_vap) > 0.d0) then
    84 
     82      if (seuil_vap - q(i, k, iq_vap) > 0.d0) THEN
    8583        if (niso > 0) zx_defau_diag(i, k, 1) &
    8684                = AMAX1(seuil_vap - q(i, k, iq_vap), 0.0)
    … …  
    113111  ENDIF
    114112
    115   !write(*,*) 'qminimum 128'
    116   if (niso > 0) then
     113  !WRITE(*,*) 'qminimum 128'
     114  if (niso > 0) THEN
    117115    ! CRisi: traiter de même les traceurs d'eau
    118116    ! Mais il faut les prendre à l'envers pour essayer de conserver la
    … …  
    123121    ! génant
    124122    DO i = 1, ip1jmp1
    125       if (zx_pump(i)>0.0) then
     123      if (zx_pump(i)>0.0) THEN
    126124        q_follow(i, 1, 1) = q_follow(i, 1, 1) + zx_pump(i)
    127       endif !if (zx_pump(i).gt.0.0) then
     125      endif !if (zx_pump(i).gt.0.0) THEN
    128126    enddo !DO i = 1,ip1jmp1
    129127
    130128    ! 2) transfert de vap vers les couches plus hautes
    131     !write(*,*) 'qminimum 139'
     129    !WRITE(*,*) 'qminimum 139'
    132130    do k = 2, llm
    133131      DO i = 1, ip1jmp1
    134         if (zx_defau_diag(i, k, 1)>0.0) then
     132        if (zx_defau_diag(i, k, 1)>0.0) THEN
    135133          ! on ajoute la vapeur en k
    136134          do ixt = 1, ntiso
    … …  
    153151                  - zx_defau_diag(i, k, 1) &
    154152                          * deltap(i, k) / deltap(i, k - 1)
    155         endif !if (zx_defau_diag(i,k,1).gt.0.0) then
     153        endif !if (zx_defau_diag(i,k,1).gt.0.0) THEN
    156154      enddo !DO i = 1, ip1jmp1
    157155    enddo !do k=2,llm
    … …  
    161159
    162160    ! 3) transfert d'eau de la vapeur au liquide
    163     !write(*,*) 'qminimum 164'
     161    !WRITE(*,*) 'qminimum 164'
    164162    do k = 1, llm
    165163      DO i = 1, ip1jmp1
    166         if (zx_defau_diag(i, k, 2)>0.0) then
    167 
     164        if (zx_defau_diag(i, k, 2)>0.0) THEN
    168165          ! ! on ajoute eau liquide en k en k
    169166          do ixt = 1, ntiso
    … …  
    180177          q_follow(i, k, 1) = q_follow(i, k, 1) &
    181178                  - zx_defau_diag(i, k, 2)
    182         endif !if (zx_defau_diag(i,k,1).gt.0.0) then
     179        endif !if (zx_defau_diag(i,k,1).gt.0.0) THEN
    183180      enddo !DO i = 1, ip1jmp1
    184181    enddo !do k=2,llm
    … …  
    186183    CALL check_isotopes_seq(q, ip1jmp1, 'qminimum 197')
    187184
    188   endif !if (niso > 0) then
    189   ! !write(*,*) 'qminimum 188'
     185  endif !if (niso > 0) THEN
     186  ! !WRITE(*,*) 'qminimum 188'
    190187
    191188  !

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

    r5103 r5116  
    7171  LOGICAL lafin
    7272
    73   integer :: ntime=10000,it,klon,klev
     73  INTEGER :: ntime=10000,it,klon,klev
    7474
    7575

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

    r5103 r5116  
    8787      enddo
    8888    enddo
    89     write(lunout, *) 'W91 ps', MAXVAL(ps), MINVAL(ps)
     89    WRITE(lunout, *) 'W91 ps', MAXVAL(ps), MINVAL(ps)
    9090    ! vitesse zonale ucov
    9191    do j = 1, jjp1
    … …  
    101101      enddo
    102102    enddo
    103     write(lunout, *) 'W91 u', MAXVAL(ucov(:, 1)), MINVAL(ucov(:, 1))
     103    WRITE(lunout, *) 'W91 u', MAXVAL(ucov(:, 1)), MINVAL(ucov(:, 1))
    104104    ucov(:, 1) = ucov(:, 1) * cu
    105105    ! vitesse meridienne vcov
    … …  
    114114      enddo
    115115    enddo
    116     write(lunout, *) 'W91 v', MAXVAL(vcov(:, 1)), MINVAL(vcov(:, 1))
     116    WRITE(lunout, *) 'W91 v', MAXVAL(vcov(:, 1)), MINVAL(vcov(:, 1))
    117117    vcov(:, 1) = vcov(:, 1) * cv
    118118

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

    r5105 r5116  
    3333  REAL :: pgcm(ilon, ilev)
    3434  REAL :: Qgcm(ilon, ilev)
    35   real :: pres
     35  REAL :: pres
    3636  REAL :: Qpres(ilon)
    3737
    … …  
    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    !=====================================================================

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

    r5105 r5116  
    3333  REAL :: pgcm(ilon, ilev)
    3434  REAL :: Qgcm(ilon, ilev)
    35   real :: pres
     35  REAL :: pres
    3636  REAL :: Qpres(ilon)
    3737
    … …  
    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    !=====================================================================

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

    r5113 r5116  
    7070  REAL :: uzon(jjp1, llm), vzon(jjm, llm), tzon(jjp1, llm)
    7171
    72   integer :: i
     72  INTEGER :: i
    7373  REAL, SAVE :: rdamp(llm) ! quenching coefficient
    7474  real, save :: lambda(llm) ! inverse or quenching time scale (Hz)
    … …  
    8080  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
    … …  
    9999    rdamp(:) = 1. - exp(-lambda(:) * dt)
    100100
    101     write(lunout, *)'TOP_BOUND mode', mode_top_bound
    102     write(lunout, *)'Sponge layer coefficients'
    103     write(lunout, *)'p (Pa)  z(km)  tau(s)   1./tau (Hz)'
     101    WRITE(lunout, *)'TOP_BOUND mode', mode_top_bound
     102    WRITE(lunout, *)'Sponge layer coefficients'
     103    WRITE(lunout, *)'p (Pa)  z(km)  tau(s)   1./tau (Hz)'
    104104    do l = 1, llm
    105       if (rdamp(l)/=0.) then
    106         write(lunout, '(6(1pe12.4,1x))') &
     105      if (rdamp(l)/=0.) THEN
     106        WRITE(lunout, '(6(1pe12.4,1x))') &
    107107                presnivs(l), log(preff / presnivs(l)) * scaleheight, &
    108108                1. / lambda(l), lambda(l)
    … …  
    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
    … …  
    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
    … …  
    161161  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
    … …  
    183183  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

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

    r5113 r5116  
    361361  ! CRisi: appel récursif de l'advection sur les fils.
    362362  ! Il faut faire ça avant d'avoir mis à jour q et masse
    363   !write(*,*) 'vlsplt 326: iq,nqDesc(iq)=',iq,tracers(iq)%nqDescen
     363  !WRITE(*,*) 'vlsplt 326: iq,nqDesc(iq)=',iq,tracers(iq)%nqDescen
    364364
    365365  do ifils=1,tracers(iq)%nqDescen
    … …  
    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
    … …  
    464464
    465465  REAL :: convpn,convps,convmpn,convmps
    466   real :: massepn,masseps,qpn,qps
     466  REAL :: massepn,masseps,qpn,qps
    467467  REAL :: sinlon(iip1),sinlondlon(iip1)
    468468  REAL :: coslon(iip1),coslondlon(iip1)
    … …  
    479479  DATA first/.TRUE./
    480480
    481   ! !write(*,*) 'vly 578: entree, iq=',iq
     481  ! !WRITE(*,*) 'vly 578: entree, iq=',iq
    482482
    483483  IF(first) THEN
    … …  
    658658  ENDDO
    659659
    660   ! !write(*,*) 'vly 756'
     660  ! !WRITE(*,*) 'vly 756'
    661661  DO l=1,llm
    662662   DO ij=1,ip1jm
    … …  
    676676  ! CRisi: appel récursif de l'advection sur les fils.
    677677  ! Il faut faire ça avant d'avoir mis à jour q et masse
    678    ! write(*,*) 'vly 689: iq,nqDesc(iq)=',iq,tracers(iq)%nqDescen
     678   ! WRITE(*,*) 'vly 689: iq,nqDesc(iq)=',iq,tracers(iq)%nqDescen
    679679
    680680  do ifils=1,tracers(iq)%nqDescen
    … …  
    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
    … …  
    744744  enddo
    745745
    746   ! !write(*,*) 'vly 853: sortie'
     746  ! !WRITE(*,*) 'vly 853: sortie'
    747747
    748748
    … …  
    814814  ENDDO
    815815
    816   ! !write(*,*) 'vlz 954'
     816  ! !WRITE(*,*) 'vlz 954'
    817817  DO ij=1,ip1jmp1
    818818     dzq(ij,1)=0.
    … …  
    846846  ! CRisi: appel récursif de l'advection sur les fils.
    847847  ! Il faut faire ça avant d'avoir mis à jour q et masse
    848   ! !write(*,*) 'vlsplt 942: iq,nqChildren(iq)=',iq,nqChildren(iq)
     848  ! !WRITE(*,*) 'vlsplt 942: iq,nqChildren(iq)=',iq,nqChildren(iq)
    849849  do ifils=1,tracers(iq)%nqDescen
    850850    iq2=tracers(iq)%iqDescen(ifils)
    … …  
    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
    … …  
    897897  INCLUDE "paramet.h"
    898898
    899   character(len=20) :: comment
    900   real :: qmin,qmax
    901   real :: zq(ip1jmp1,llm)
    902   real :: zzq(iip1,jjp1,llm)
     899  CHARACTER(LEN=20) :: comment
     900  REAL :: qmin,qmax
     901  REAL :: zq(ip1jmp1,llm)
     902  REAL :: zzq(iip1,jjp1,llm)
    903903
    904904END SUBROUTINE  minmaxq

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

    r5113 r5116  
    171171    ENDDO
    172172  enddo
    173   !write(*,*) 'vlspltqs 183: fin de la routine'
     173  !WRITE(*,*) 'vlspltqs 183: fin de la routine'
    174174
    175175
    … …  
    452452  ! CRisi: appel récursif de l'advection sur les fils.
    453453  ! Il faut faire ça avant d'avoir mis à jour q et masse
    454   !write(*,*) 'vlspltqs 326: iq,nqChildren(iq)=',iq,
     454  !WRITE(*,*) 'vlspltqs 326: iq,nqChildren(iq)=',iq,
    455455  ! &                 tracers(iq)%nqChildren
    456456
    … …  
    758758  ! CRisi: appel récursif de l'advection sur les fils.
    759759  ! Il faut faire ça avant d'avoir mis à jour q et masse
    760   !write(*,*) 'vlyqs 689: iq,nqChildren(iq)=',iq,
     760  !WRITE(*,*) 'vlyqs 689: iq,nqChildren(iq)=',iq,
    761761  ! &              tracers(iq)%nqChildren
    762762
    … …  
    772772  do ifils = 1, tracers(iq)%nqChildren
    773773    iq2 = tracers(iq)%iqDescen(ifils)
    774     ! !write(*,*) 'vlyqs 783: appel rec de vly, iq2=',iq2
     774    ! !WRITE(*,*) 'vlyqs 783: appel rec de vly, iq2=',iq2
    775775    CALL vly(Ratio, pente_max, masseq, qbyv, iq2)
    776776  enddo
    … …  
    827827  ENDDO
    828828
    829   ! !write(*,*) 'vly 866'
     829  ! !WRITE(*,*) 'vly 866'
    830830
    831831  ! retablir les fils en rapport de melange par rapport a l'air:
    … …  
    838838    enddo
    839839  enddo
    840   ! !write(*,*) 'vly 879'
     840  ! !WRITE(*,*) 'vly 879'
    841841
    842842

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

    r5113 r5116  
    22
    33subroutine wrgrads(if, nl, field, name, titlevar)
     4  USE lmdz_formcoord, ONLY: formcoord
    45  IMPLICIT NONE
    56
    … …  
    1415
    1516  !   arguments
    16   integer :: if, nl
    17   real :: field(imx * jmx * lmx)
     17  INTEGER :: if, nl
     18  REAL :: field(imx * jmx * lmx)
    1819
    1920  integer, parameter :: wp = selected_real_kind(p = 6, r = 36)
    2021  real(wp) field4(imx * jmx * lmx)
    2122
    22   character(len = 10) :: name, file
    23   character(len = 10) :: titlevar
     23  CHARACTER(LEN = 10) :: name, file
     24  CHARACTER(LEN = 10) :: titlevar
    2425
    2526  !   local
    2627
    27   integer :: im, jm, lm, i, j, l, iv, iii, iji, iif, ijf
     28  INTEGER :: im, jm, lm, i, j, l, iv, iii, iji, iif, ijf
    2829
    2930  logical :: writectl
    … …  
    4344  ! print*,im,jm,lm,name,firsttime(if)
    4445
    45   if(firsttime(if)) then
    46     if(name==var(1, if)) then
     46  IF(firsttime(if)) THEN
     47    IF(name==var(1, if)) THEN
    4748      firsttime(if) = .false.
    4849      ivar(if) = 1
    … …  
    6667  else
    6768    ivar(if) = mod(ivar(if), nvar(if)) + 1
    68     if (ivar(if)==nvar(if)) then
     69    if (ivar(if)==nvar(if)) THEN
    6970      writectl = .true.
    7071      itime(if) = itime(if) + 1
    7172    endif
    7273
    73     if(var(ivar(if), if)/=name) then
     74    IF(var(ivar(if), if)/=name) THEN
    7475      print*, 'Il faut stoker la meme succession de champs a chaque'
    7576      print*, 'pas de temps'
    … …  
    9091    !    s (l-1)*imd(if)*jmd(if)+(iji-1)*imd(if)+iii
    9192    !    s ,(l-1)*imd(if)*jmd(if)+(ijf-1)*imd(if)+iif
    92     write(unit(if) + 1, rec = irec(if)) &
     93    WRITE(unit(if) + 1, rec = irec(if)) &
    9394            ((field4((l - 1) * imd(if) * jmd(if) + (j - 1) * imd(if) + i) &
    9495                    , i = iii, iif), j = iji, ijf)
    9596  enddo
    96   if (writectl) then
    97 
     97  if (writectl) THEN
    9898    file = fichier(if)
    9999    !   WARNING! on reecrase le fichier .ctl a chaque ecriture
    100100    open(unit(if), file = trim(file) // '.ctl' &
    101101            , form = 'formatted', status = 'unknown')
    102     write(unit(if), '(a5,1x,a40)') &
     102    WRITE(unit(if), '(a5,1x,a40)') &
    103103            'DSET ', '^' // trim(file) // '.dat'
    104104
    105     write(unit(if), '(a12)') 'UNDEF 1.0E30'
    106     write(unit(if), '(a5,1x,a40)') 'TITLE ', title(if)
     105    WRITE(unit(if), '(a12)') 'UNDEF 1.0E30'
     106    WRITE(unit(if), '(a5,1x,a40)') 'TITLE ', title(if)
    107107    CALL formcoord(unit(if), im, xd(iii, if), 1., .false., 'XDEF')
    108108    CALL formcoord(unit(if), jm, yd(iji, if), 1., .true., 'YDEF')
    109109    CALL formcoord(unit(if), lm, zd(1, if), 1., .false., 'ZDEF')
    110     write(unit(if), '(a4,i10,a30)') &
     110    WRITE(unit(if), '(a4,i10,a30)') &
    111111            'TDEF ', itime(if), ' LINEAR 02JAN1987 1MO '
    112     write(unit(if), '(a4,2x,i5)') 'VARS', nvar(if)
     112    WRITE(unit(if), '(a4,2x,i5)') 'VARS', nvar(if)
    113113    do iv = 1, nvar(if)
    114114      ! print*,'if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)'
    115115      ! print*,if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)
    116       write(unit(if), 1000) var(iv, if), nld(iv, if) - 1 / nld(iv, if) &
     116      WRITE(unit(if), 1000) var(iv, if), nld(iv, if) - 1 / nld(iv, if) &
    117117              , 99, tvar(iv, if)
    118118    enddo
    119     write(unit(if), '(a7)') 'ENDVARS'
     119    WRITE(unit(if), '(a7)') 'ENDVARS'
    120120    !
    121121    1000   format(a5, 3x, i4, i3, 1x, a39)
    … …  
    125125  endif ! writectl
    126126
    127 
    128 
    129127END SUBROUTINE wrgrads
    130128

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

    r5101 r5116  
    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.