Ignore:
Timestamp:
Jul 23, 2024, 8:22:55 AM (4 months ago)
Author:
abarral
Message:

Handle DEBUG_IO in lmdz_cppkeys_wrapper.F90
Transform some files .F -> .[fF]90
[ne compile pas à cause de writefield_u non défini - en attente de réponse Laurent]

Location:
LMDZ6/branches/Amaury_dev/libf/dyn3d_common
Files:
26 edited
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/advn.F

    r5099 r5101  
    9999      enddo
    100100
    101 c     call minmaxq(zq,qmin,qmax,'avant vlx     ')
    102       call advnqx(zq,zqg,zqd)
    103       call advnx(zq,zqg,zqd,zm,mu,mode)
    104       call advnqy(zq,zqs,zqn)
    105       call advny(zq,zqs,zqn,zm,mv)
    106       call advnqz(zq,zqh,zqb)
    107       call advnz(zq,zqh,zqb,zm,mw)
    108 c     call vlz(zq,0.,zm,mw)
    109       call advnqy(zq,zqs,zqn)
    110       call advny(zq,zqs,zqn,zm,mv)
    111       call advnqx(zq,zqg,zqd)
    112       call advnx(zq,zqg,zqd,zm,mu,mode)
    113 c     call minmaxq(zq,qmin,qmax,'apres vlx     ')
     101c     CALL minmaxq(zq,qmin,qmax,'avant vlx     ')
     102      CALL advnqx(zq,zqg,zqd)
     103      CALL advnx(zq,zqg,zqd,zm,mu,mode)
     104      CALL advnqy(zq,zqs,zqn)
     105      CALL advny(zq,zqs,zqn,zm,mv)
     106      CALL advnqz(zq,zqh,zqb)
     107      CALL advnz(zq,zqh,zqb,zm,mw)
     108c     CALL vlz(zq,0.,zm,mw)
     109      CALL advnqy(zq,zqs,zqn)
     110      CALL advny(zq,zqs,zqn,zm,mv)
     111      CALL advnqx(zq,zqg,zqd)
     112      CALL advnx(zq,zqg,zqd,zm,mu,mode)
     113c     CALL minmaxq(zq,qmin,qmax,'apres vlx     ')
    114114
    115115      do l=1,llm

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/conf_planete.F90

    r5099 r5101  
    8181! Intrinsic heat flux (default: none) (only used if planet_type="giant")
    8282ihf = 0.
    83 call getin('ihf',ihf)
     83CALL getin('ihf',ihf)
    8484
    8585END SUBROUTINE conf_planete

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/control_mod.F90

    r5099 r5101  
    1616  INTEGER,SAVE :: iapp_tracvl ! apply (cumulated) traceur advection every
    1717                              ! iapp_tracvl dynamical steps
    18   INTEGER,SAVE :: nsplit_phys ! number of sub-cycle steps in call to physics
     18  INTEGER,SAVE :: nsplit_phys ! number of sub-cycle steps in CALL to physics
    1919  INTEGER,SAVE :: iconser
    2020  INTEGER,SAVE :: iecri
    2121  INTEGER,SAVE :: dissip_period ! apply dissipation every dissip_period
    2222                                ! dynamical step
    23   INTEGER,SAVE :: iphysiq ! call physics every iphysiq dynamical steps
     23  INTEGER,SAVE :: iphysiq ! CALL physics every iphysiq dynamical steps
    2424  INTEGER,SAVE :: iecrimoy
    2525  INTEGER,SAVE :: dayref

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/diagedyn.F

    r5099 r5101  
    5252c======================================================================
    5353 
    54       USE control_mod, ONLY : planet_type
     54      USE control_mod, ONLY: planet_type
    5555     
    5656      IMPLICIT NONE

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert.F90

    r5099 r5101  
    6464
    6565  vert_sampling = merge("strato", "tropo ", ok_strato) ! default value
    66   call getin('vert_sampling', vert_sampling)
     66  CALL getin('vert_sampling', vert_sampling)
    6767  WRITE(lunout,*) TRIM(modname)//' vert_sampling = ' // vert_sampling
    6868  if (llm==39 .and. vert_sampling=="strato") then

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert_noterre.F

    r5093 r5101  
    181181         DO l = 1, llm
    182182
    183          call sig_hybrid(sig(l),pa,preff,newsig)
     183         CALL sig_hybrid(sig(l),pa,preff,newsig)
    184184            bp(l) = EXP( 1. - 1./(newsig**2)  )
    185185            ap(l) = pa * (newsig - bp(l) )

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/exner_hyb_m.F90

    r5099 r5101  
    6060       if (llm==1) then
    6161          if (kappa/=1) then
    62              call abort_gcm(modname, &
     62             CALL abort_gcm(modname, &
    6363                  "kappa!=1 , but running in Shallow Water mode!!",42)
    6464          endif
    6565          if (cpp/=r) then
    66              call abort_gcm(modname, &
     66             CALL abort_gcm(modname, &
    6767                  "cpp!=r , but running in Shallow Water mode!!",42)
    6868          endif

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/exner_milieu_m.F90

    r5099 r5101  
    5757       if (llm==1) then
    5858          if (kappa/=1) then
    59              call abort_gcm(modname, &
     59             CALL abort_gcm(modname, &
    6060                  "kappa!=1 , but running in Shallow Water mode!!",42)
    6161          endif
    6262          if (cpp/=r) then
    63              call abort_gcm(modname, &
     63             CALL abort_gcm(modname, &
    6464                  "cpp!=r , but running in Shallow Water mode!!",42)
    6565          endif

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/extrapol.F

    r5099 r5101  
    150150C
    151151C* Not enough points around point P are unmasked; interpolation on P
    152 C  will be done in a future call to extrap.
     152C  will be done in a future CALL to extrap.
    153153C
    154154         IF (inbor >= knbor) THEN

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fxhyp_m.F90

    r5086 r5101  
    172172          Xf(2 * nmax) = pi_d
    173173
    174           call invert_zoom_x(xf, xtild, Xprimt, rlonm025(:iim), &
     174          CALL invert_zoom_x(xf, xtild, Xprimt, rlonm025(:iim), &
    175175               xprimm025(:iim), xuv = - 0.25_k8)
    176           call invert_zoom_x(xf, xtild, Xprimt, rlonv(:iim), xprimv(:iim), &
     176          CALL invert_zoom_x(xf, xtild, Xprimt, rlonv(:iim), xprimv(:iim), &
    177177               xuv = 0._k8)
    178           call invert_zoom_x(xf, xtild, Xprimt, rlonu(:iim), xprimu(:iim), &
     178          CALL invert_zoom_x(xf, xtild, Xprimt, rlonu(:iim), xprimu(:iim), &
    179179               xuv = 0.5_k8)
    180           call invert_zoom_x(xf, xtild, Xprimt, rlonp025(:iim), &
     180          CALL invert_zoom_x(xf, xtild, Xprimt, rlonp025(:iim), &
    181181               xprimp025(:iim), xuv = 0.25_k8)
    182182       end if test_grossismx
    … …  
    211211       END IF
    212212
    213        call principal_cshift(is2, rlonm025, xprimm025)
    214        call principal_cshift(is2, rlonv, xprimv)
    215        call principal_cshift(is2, rlonu, xprimu)
    216        call principal_cshift(is2, rlonp025, xprimp025)
     213       CALL principal_cshift(is2, rlonm025, xprimm025)
     214       CALL principal_cshift(is2, rlonv, xprimv)
     215       CALL principal_cshift(is2, rlonu, xprimu)
     216       CALL principal_cshift(is2, rlonp025, xprimp025)
    217217
    218218       forall (i = 1: iim) d_rlonv(i) = rlonv(i + 1) - rlonv(i)

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/grilles_gcm_netcdf_sub.F90

    r5100 r5101  
    182182  status=nf90_put_att(ncid_out,area_id,'long_name','gridcell area')
    183183  ! land-sea mask (nearest integer approx)
    184   status = nf90_def_var(ncid_out,'mask',NF90_INT,out_dim,mask_id)
     184  status = nf90_def_var(ncid_out,'mask',nf90_int,out_dim,mask_id)
    185185  CALL handle_err(status)
    186186  status=nf90_put_att(ncid_out,mask_id,'long_name','land-sea mask (nINT approx)')

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

    r5099 r5101  
    33MODULE infotrac
    44
    5   USE       strings_mod, ONLY : msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse
    6   USE readTracFiles_mod, ONLY : trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
     5  USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse
     6  USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
    77          delPhase, niso, getKey, isot_type, processIsotopes, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
    88          addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate, iqWIsoPha, nbIso, ntiso, isoName, isoCheck
    … …  
    113113
    114114  SUBROUTINE init_infotrac
    115     USE control_mod, ONLY : planet_type
     115    USE control_mod, ONLY: planet_type
    116116#ifdef REPROBUS
    117117   USE CHEM_REP,    ONLY: Init_chem_rep_trac
    118118#endif
    119     USE lmdz_cppkeys_wrapper, ONLY : CPPKEY_INCA, CPPKEY_STRATAER
     119    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_STRATAER
    120120    IMPLICIT NONE
    121121    !==============================================================================================================================

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iniconst.F90

    r5099 r5101  
    6464  endif
    6565  ! but user can also specify using one or the other in run.def:
    66   call getin('disvert_type',disvert_type)
     66  CALL getin('disvert_type',disvert_type)
    6767  write(lunout,*) trim(modname),': disvert_type=',disvert_type
    6868
    6969  pressure_exner = disvert_type == 1 ! default value
    70   call getin('pressure_exner', pressure_exner)
     70  CALL getin('pressure_exner', pressure_exner)
    7171
    7272  if (disvert_type==1) then
    7373     ! standard case for Earth (automatic generation of levels)
    74      call disvert()
     74     CALL disvert()
    7575  else if (disvert_type==2) then
    7676     ! standard case for planets (levels generated using z2sig.def file)
    77      call disvert_noterre
     77     CALL disvert_noterre
    7878  else
    7979     write(abort_message,*) "Wrong value for disvert_type: ", disvert_type
    80      call abort_gcm(modname,abort_message,0)
     80     CALL abort_gcm(modname,abort_message,0)
    8181  endif
    8282

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inidissip.F90

    r5099 r5101  
    1111  !   -------------
    1212
    13   USE control_mod, only : dissip_period,iperiod
     13  USE control_mod, ONLY: dissip_period,iperiod
    1414  USE comconst_mod, ONLY: dissip_deltaz, dissip_factz, dissip_zref, &
    1515                          dtdiss, dtvr, rad
    … …  
    7979     write(lunout,*)'  Inidissip  zh min max  ',zhmin,zhmax
    8080     abort_message='probleme generateur alleatoire dans inidissip'
    81      call abort_gcm('inidissip',abort_message,1)
     81     CALL abort_gcm('inidissip',abort_message,1)
    8282  ENDIF
    8383

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initdynav.F90

    r4046 r5101  
    66  USE IOIPSL
    77#endif
    8   USE infotrac, ONLY : nqtot
    9   use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid, &
     8  USE infotrac, ONLY: nqtot
     9  use com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid, &
    1010       dynhistave_file,dynhistvave_file,dynhistuave_file
    1111  USE comconst_mod, ONLY: pi
    … …  
    8383  ! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier
    8484  ! Grille Scalaire       
    85   call histbeg(dynhistave_file, iip1, rlong(:,1), jjp1, rlat(1,:), &
     85  CALL histbeg(dynhistave_file, iip1, rlong(:,1), jjp1, rlat(1,:), &
    8686       1, iip1, 1, jjp1, &
    8787       tau0, zjulian, tstep, thoriid,histaveid)
    … …  
    9898  enddo
    9999
    100   call histbeg(dynhistvave_file, iip1, rlong(:,1), jjm, rlat(1,:), &
     100  CALL histbeg(dynhistvave_file, iip1, rlong(:,1), jjm, rlat(1,:), &
    101101       1, iip1, 1, jjm, &
    102102       tau0, zjulian, tstep, vhoriid,histvaveid)
    … …  
    109109  enddo
    110110
    111   call histbeg(dynhistuave_file, iip1, rlong(:,1),jjp1, rlat(1,:), &
     111  CALL histbeg(dynhistuave_file, iip1, rlong(:,1),jjp1, rlat(1,:), &
    112112       1, iip1, 1, jjp1, &
    113113       tau0, zjulian, tstep, uhoriid,histuaveid)
    … …  
    115115  !  Appel a histvert pour la grille verticale
    116116
    117   call histvert(histaveid,'presnivs','Niveaux Pression approximatifs','mb', &
     117  CALL histvert(histaveid,'presnivs','Niveaux Pression approximatifs','mb', &
    118118       llm, presnivs/100., zvertiid,'down')
    119   call histvert(histuaveid,'presnivs','Niveaux Pression approximatifs','mb', &
     119  CALL histvert(histuaveid,'presnivs','Niveaux Pression approximatifs','mb', &
    120120       llm, presnivs/100., zvertiid,'down')
    121   call histvert(histvaveid,'presnivs','Niveaux Pression approximatifs','mb', &
     121  CALL histvert(histvaveid,'presnivs','Niveaux Pression approximatifs','mb', &
    122122       llm, presnivs/100., zvertiid,'down')
    123123
    … …  
    126126  !  Vents U
    127127
    128   call histdef(histuaveid, 'u', 'vent u moyen ', &
     128  CALL histdef(histuaveid, 'u', 'vent u moyen ', &
    129129       'm/s', iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &
    130130       32, 'ave(X)', t_ops, t_wrt)
    … …  
    132132  !  Vents V
    133133
    134   call histdef(histvaveid, 'v', 'vent v moyen', &
     134  CALL histdef(histvaveid, 'v', 'vent v moyen', &
    135135       'm/s', iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &
    136136       32, 'ave(X)', t_ops, t_wrt)
    … …  
    139139  !  Temperature
    140140
    141   call histdef(histaveid, 'temp', 'temperature moyenne', 'K', &
     141  CALL histdef(histaveid, 'temp', 'temperature moyenne', 'K', &
    142142       iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
    143143       32, 'ave(X)', t_ops, t_wrt)
    … …  
    145145  !  Temperature potentielle
    146146
    147   call histdef(histaveid, 'theta', 'temperature potentielle', 'K', &
     147  CALL histdef(histaveid, 'theta', 'temperature potentielle', 'K', &
    148148       iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
    149149       32, 'ave(X)', t_ops, t_wrt)
    … …  
    151151  !  Geopotentiel
    152152
    153   call histdef(histaveid, 'phi', 'geopotentiel moyen', '-', &
     153  CALL histdef(histaveid, 'phi', 'geopotentiel moyen', '-', &
    154154       iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
    155155       32, 'ave(X)', t_ops, t_wrt)
    … …  
    158158
    159159  !        DO iq=1,nqtot
    160   !          call histdef(histaveid, tracers(iq)%name, &
     160  !          CALL histdef(histaveid, tracers(iq)%name, &
    161161  !                                  tracers(iq)%longName, '-',  &
    162162  !                  iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
    … …  
    166166  !  Masse
    167167
    168   call histdef(histaveid, 'masse', 'masse', 'kg', &
     168  CALL histdef(histaveid, 'masse', 'masse', 'kg', &
    169169       iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
    170170       32, 'ave(X)', t_ops, t_wrt)
    … …  
    172172  !  Pression au sol
    173173
    174   call histdef(histaveid, 'ps', 'pression naturelle au sol', 'Pa', &
     174  CALL histdef(histaveid, 'ps', 'pression naturelle au sol', 'Pa', &
    175175       iip1, jjp1, thoriid, 1, 1, 1, -99, &
    176176       32, 'ave(X)', t_ops, t_wrt)
    … …  
    178178  !  Geopotentiel au sol
    179179
    180   !      call histdef(histaveid, 'phis', 'geopotentiel au sol', '-', &
     180  !      CALL histdef(histaveid, 'phis', 'geopotentiel au sol', '-', &
    181181  !                  iip1, jjp1, thoriid, 1, 1, 1, -99, &
    182182  !                  32, 'ave(X)', t_ops, t_wrt)
    183183
    184   call histend(histaveid)
    185   call histend(histuaveid)
    186   call histend(histvaveid)
     184  CALL histend(histaveid)
     185  CALL histend(histuaveid)
     186  CALL histend(histvaveid)
    187187#else
    188188  write(lunout,*)"initdynav: Warning this routine should not be", &

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initfluxsto.F

    r5099 r5101  
    9292      enddo
    9393 
    94       call histbeg(infile, iip1, rlong(:,1), jjp1, rlat(1,:),
     94      CALL histbeg(infile, iip1, rlong(:,1), jjp1, rlat(1,:),
    9595     .             1, iip1, 1, jjp1,
    9696     .             tau0, zjulian, tstep, uhoriid, fileid)
    … …  
    108108      enddo
    109109
    110       call histbeg('fluxstokev.nc', iip1, rlong(:,1), jjm, rlat(1,:),
     110      CALL histbeg('fluxstokev.nc', iip1, rlong(:,1), jjm, rlat(1,:),
    111111     .             1, iip1, 1, jjm,
    112112     .             tau0, zjulian, tstep, vhoriid, filevid)
    113113       
    114114        rl(1,1) = 1.
    115       call histbeg('defstoke.nc', 1, rl, 1, rl,
     115      CALL histbeg('defstoke.nc', 1, rl, 1, rl,
    116116     .             1, 1, 1, 1,
    117117     .             tau0, zjulian, tstep, dhoriid, filedid)
    … …  
    127127      enddo
    128128
    129       call histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar',
     129      CALL histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar',
    130130     .              'Grille points scalaires', thoriid)
    131131       
    … …  
    133133C  Appel a histvert pour la grille verticale
    134134C
    135       call histvert(fileid, 'sig_s', 'Niveaux sigma',
     135      CALL histvert(fileid, 'sig_s', 'Niveaux sigma',
    136136     . 'sigma_level',
    137137     .              llm, nivsigs, zvertiid)
    138138C Pour le fichier V
    139       call histvert(filevid, 'sig_s', 'Niveaux sigma',
     139      CALL histvert(filevid, 'sig_s', 'Niveaux sigma',
    140140     .  'sigma_level',
    141141     .              llm, nivsigs, zvertiid)
    142142c pour le fichier def
    143143      nivd(1) = 1
    144       call histvert(filedid, 'sig_s', 'Niveaux sigma',
     144      CALL histvert(filedid, 'sig_s', 'Niveaux sigma',
    145145     .  'sigma_level',
    146146     .              1, nivd, dvertiid)
    … …  
    173173C Masse
    174174C
    175       call histdef(fileid, 'masse', 'Masse', 'kg',
     175      CALL histdef(fileid, 'masse', 'Masse', 'kg',
    176176     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    177177     .             32, 'inst(X)', t_ops, t_wrt)
    … …  
    179179C  Pbaru
    180180C
    181       call histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',
     181      CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',
    182182     .             iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
    183183     .             32, 'inst(X)', t_ops, t_wrt)
    … …  
    186186C  Pbarv
    187187C
    188       call histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',
     188      CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',
    189189     .             iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
    190190     .             32, 'inst(X)', t_ops, t_wrt)
    … …  
    192192C  w
    193193C
    194       call histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',
     194      CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',
    195195     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    196196     .             32, 'inst(X)', t_ops, t_wrt)
    … …  
    199199C  Temperature potentielle
    200200C
    201       call histdef(fileid, 'teta', 'temperature potentielle', '-',
     201      CALL histdef(fileid, 'teta', 'temperature potentielle', '-',
    202202     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    203203     .             32, 'inst(X)', t_ops, t_wrt)
    … …  
    207207C Geopotentiel
    208208C
    209       call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
     209      CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-',
    210210     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    211211     .             32, 'inst(X)', t_ops, t_wrt)
    … …  
    213213C  Fin
    214214C
    215       call histend(fileid)
    216       call histend(filevid)
    217       call histend(filedid)
     215      CALL histend(fileid)
     216      CALL histend(filevid)
     217      CALL histend(filedid)
    218218      if (ok_sync) then
    219         call histsync(fileid)
    220         call histsync(filevid)
    221         call histsync(filedid)
     219        CALL histsync(fileid)
     220        CALL histsync(filevid)
     221        CALL histsync(filedid)
    222222      endif
    223223       

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inithist.F90

    r5100 r5101  
    1 
    21! $Id$
    32
    4       subroutine inithist(day0,anne0,tstep,t_ops,t_wrt)
     3subroutine inithist(day0, anne0, tstep, t_ops, t_wrt)
    54
    65#ifdef CPP_IOIPSL
    7        USE IOIPSL
     6   USE IOIPSL
    87#endif
    9        USE infotrac, ONLY : nqtot
    10        use com_io_dyn_mod, only : histid,histvid,histuid,               &
    11      &                        dynhist_file,dynhistv_file,dynhistu_file
    12        USE comconst_mod, ONLY: pi
    13        USE comvert_mod, ONLY: presnivs
    14        USE temps_mod, ONLY: itau_dyn
    15        
    16       implicit none
     8  USE infotrac, ONLY: nqtot
     9  use com_io_dyn_mod, ONLY: histid, histvid, histuid, &
     10          dynhist_file, dynhistv_file, dynhistu_file
     11  USE comconst_mod, ONLY: pi
     12  USE comvert_mod, ONLY: presnivs
     13  USE temps_mod, ONLY: itau_dyn
    1714
    18 C
    19 C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
    20 C   au format IOIPSL
    21 C
    22 C   Appels succesifs des routines: histbeg
    23 C                                  histhori
    24 C                                  histver
    25 C                                  histdef
    26 C                                  histend
    27 C
    28 C   Entree:
    29 C
    30 C      infile: nom du fichier histoire a creer
    31 C      day0,anne0: date de reference
    32 C      tstep: duree du pas de temps en seconde
    33 C      t_ops: frequence de l'operation pour IOIPSL
    34 C      t_wrt: frequence d'ecriture sur le fichier
    35 C      nq: nombre de traceurs
    36 C
    37 C
    38 C   L. Fairhead, LMD, 03/99
    39 C
    40 C =====================================================================
    41 C
    42 C   Declarations
    43       include "dimensions.h"
    44       include "paramet.h"
    45       include "comgeom.h"
    46       include "description.h"
    47       include "iniprint.h"
     15  implicit none
    4816
    49 C   Arguments
    50 C
    51       integer day0, anne0
    52       real tstep, t_ops, t_wrt
     17  !
     18  !   Routine d'initialisation des ecritures des fichiers histoires LMDZ
     19  !   au format IOIPSL
     20  !
     21  !   Appels succesifs des routines: histbeg
     22  !                              histhori
     23  !                              histver
     24  !                              histdef
     25  !                              histend
     26  !
     27  !   Entree:
     28  !
     29  !  infile: nom du fichier histoire a creer
     30  !  day0,anne0: date de reference
     31  !  tstep: duree du pas de temps en seconde
     32  !  t_ops: frequence de l'operation pour IOIPSL
     33  !  t_wrt: frequence d'ecriture sur le fichier
     34  !  nq: nombre de traceurs
     35  !
     36  !
     37  !   L. Fairhead, LMD, 03/99
     38  !
     39  ! =====================================================================
     40  !
     41  !   Declarations
     42  include "dimensions.h"
     43  include "paramet.h"
     44  include "comgeom.h"
     45  include "description.h"
     46  include "iniprint.h"
     47
     48  !   Arguments
     49  !
     50  integer :: day0, anne0
     51  real :: tstep, t_ops, t_wrt
    5352
    5453#ifdef CPP_IOIPSL
    55 ! This routine needs IOIPSL to work
    56 C   Variables locales
    57 C
    58       integer tau0
    59       real zjulian
    60       integer iq
    61       real rlong(iip1,jjp1), rlat(iip1,jjp1)
    62       integer uhoriid, vhoriid, thoriid, zvertiid
    63       integer ii,jj
    64       integer zan, dayref
    65 C
    66 C  Initialisations
    67 C
    68       pi = 4. * atan (1.)
    69 C
    70 C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
    71 C         
     54  ! This routine needs IOIPSL to work
     55  !   Variables locales
     56  !
     57  integer :: tau0
     58  real :: zjulian
     59  integer :: iq
     60  real :: rlong(iip1,jjp1), rlat(iip1,jjp1)
     61  integer :: uhoriid, vhoriid, thoriid, zvertiid
     62  integer :: ii,jj
     63  integer :: zan, dayref
     64  !
     65  !  Initialisations
     66  !
     67  pi = 4. * atan (1.)
     68  !
     69  !  Appel a histbeg: creation du fichier netcdf et initialisations diverses
     70  !
    7271
    73       zan = anne0
    74       dayref = day0
    75       CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
    76       tau0 = itau_dyn
    77      
    78 ! -------------------------------------------------------------
    79 ! Creation des 3 fichiers pour les grilles horizontales U,V,Scal
    80 ! -------------------------------------------------------------
    81 !Grille U     
    82       do jj = 1, jjp1
    83         do ii = 1, iip1
    84           rlong(ii,jj) = rlonu(ii) * 180. / pi
    85           rlat(ii,jj) = rlatu(jj) * 180. / pi
    86         enddo
    87       enddo
    88        
    89       call histbeg(dynhistu_file, iip1, rlong(:,1), jjp1, rlat(1,:),
    90      .             1, iip1, 1, jjp1,
    91      .             tau0, zjulian, tstep, uhoriid, histuid)
     72  zan = anne0
     73  dayref = day0
     74  CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
     75  tau0 = itau_dyn
    9276
    93 ! Grille V
    94       do jj = 1, jjm
    95         do ii = 1, iip1
    96           rlong(ii,jj) = rlonv(ii) * 180. / pi
    97           rlat(ii,jj) = rlatv(jj) * 180. / pi
    98         enddo
    99       enddo
     77  ! -------------------------------------------------------------
     78  ! Creation des 3 fichiers pour les grilles horizontales U,V,Scal
     79  ! -------------------------------------------------------------
     80  !Grille U
     81  do jj = 1, jjp1
     82    do ii = 1, iip1
     83      rlong(ii,jj) = rlonu(ii) * 180. / pi
     84      rlat(ii,jj) = rlatu(jj) * 180. / pi
     85    enddo
     86  enddo
    10087
    101       call histbeg(dynhistv_file, iip1, rlong(:,1), jjm, rlat(1,:),
    102      .             1, iip1, 1, jjm,
    103      .             tau0, zjulian, tstep, vhoriid, histvid)
     88  CALL histbeg(dynhistu_file, iip1, rlong(:,1), jjp1, rlat(1,:), &
     89        1, iip1, 1, jjp1, &
     90        tau0, zjulian, tstep, uhoriid, histuid)
    10491
    105 !Grille Scalaire
    106       do jj = 1, jjp1
    107         do ii = 1, iip1
    108           rlong(ii,jj) = rlonv(ii) * 180. / pi
    109           rlat(ii,jj) = rlatu(jj) * 180. / pi
    110         enddo
    111       enddo
     92  ! Grille V
     93  do jj = 1, jjm
     94    do ii = 1, iip1
     95      rlong(ii,jj) = rlonv(ii) * 180. / pi
     96      rlat(ii,jj) = rlatv(jj) * 180. / pi
     97    enddo
     98  enddo
    11299
    113       call histbeg(dynhist_file, iip1, rlong(:,1), jjp1, rlat(1,:),
    114      .             1, iip1, 1, jjp1,
    115      .             tau0, zjulian, tstep, thoriid, histid)
    116 ! -------------------------------------------------------------
    117 C  Appel a histvert pour la grille verticale
    118 ! -------------------------------------------------------------
    119       call histvert(histid, 'presnivs', 'Niveaux pression','mb',
    120      .              llm, presnivs/100., zvertiid,'down')
    121       call histvert(histvid, 'presnivs', 'Niveaux pression','mb',
    122      .              llm, presnivs/100., zvertiid,'down')
    123       call histvert(histuid, 'presnivs', 'Niveaux pression','mb',
    124      .              llm, presnivs/100., zvertiid,'down')
    125 C
    126 ! -------------------------------------------------------------
    127 C  Appels a histdef pour la definition des variables a sauvegarder
    128 ! -------------------------------------------------------------
    129 C
    130 C  Vents U
    131 C
    132       call histdef(histuid, 'u', 'vent u', 'm/s',
    133      .             iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
    134      .             32, 'inst(X)', t_ops, t_wrt)
    135 C
    136 C  Vents V
    137 C
    138       call histdef(histvid, 'v', 'vent v', 'm/s',
    139      .             iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
    140      .             32, 'inst(X)', t_ops, t_wrt)
     100  CALL histbeg(dynhistv_file, iip1, rlong(:,1), jjm, rlat(1,:), &
     101        1, iip1, 1, jjm, &
     102        tau0, zjulian, tstep, vhoriid, histvid)
    141103
    142 C
    143 C  Temperature potentielle
    144 C
    145       call histdef(histid, 'teta', 'temperature potentielle', '-',
    146      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    147      .             32, 'inst(X)', t_ops, t_wrt)
    148 C
    149 C  Geopotentiel
    150 C
    151       call histdef(histid, 'phi', 'geopotentiel', '-',
    152      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    153      .             32, 'inst(X)', t_ops, t_wrt)
    154 C
    155 C  Traceurs
    156 C
     104  !Grille Scalaire
     105  do jj = 1, jjp1
     106    do ii = 1, iip1
     107      rlong(ii,jj) = rlonv(ii) * 180. / pi
     108      rlat(ii,jj) = rlatu(jj) * 180. / pi
     109    enddo
     110  enddo
    157111
    158 !        DO iq=1,nqtot
    159 !          call histdef(histid, tracers(iq)%name,
    160 !                               tracers(iq)%longName, '-',
    161 !     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    162 !     .             32, 'inst(X)', t_ops, t_wrt)
    163 !        enddo
    164 !C
    165 C  Masse
    166 C
    167       call histdef(histid, 'masse', 'masse', 'kg',
    168      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    169      .             32, 'inst(X)', t_ops, t_wrt)
    170 C
    171 C  Pression au sol
    172 C
    173       call histdef(histid, 'ps', 'pression naturelle au sol', 'Pa',
    174      .             iip1, jjp1, thoriid, 1, 1, 1, -99,
    175      .             32, 'inst(X)', t_ops, t_wrt)
    176 C
    177 C  Geopotentiel au sol
    178 !C
    179 !      call histdef(histid, 'phis', 'geopotentiel au sol', '-',
    180 !     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
    181 !     .             32, 'inst(X)', t_ops, t_wrt)
    182 !C
    183 C  Fin
    184 C
    185       call histend(histid)
    186       call histend(histuid)
    187       call histend(histvid)
     112  CALL histbeg(dynhist_file, iip1, rlong(:,1), jjp1, rlat(1,:), &
     113        1, iip1, 1, jjp1, &
     114        tau0, zjulian, tstep, thoriid, histid)
     115  ! -------------------------------------------------------------
     116  !  Appel a histvert pour la grille verticale
     117  ! -------------------------------------------------------------
     118  CALL histvert(histid, 'presnivs', 'Niveaux pression','mb', &
     119        llm, presnivs/100., zvertiid,'down')
     120  CALL histvert(histvid, 'presnivs', 'Niveaux pression','mb', &
     121        llm, presnivs/100., zvertiid,'down')
     122  CALL histvert(histuid, 'presnivs', 'Niveaux pression','mb', &
     123        llm, presnivs/100., zvertiid,'down')
     124  !
     125  ! -------------------------------------------------------------
     126  !  Appels a histdef pour la definition des variables a sauvegarder
     127  ! -------------------------------------------------------------
     128  !
     129  !  Vents U
     130  !
     131  CALL histdef(histuid, 'u', 'vent u', 'm/s', &
     132        iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &
     133        32, 'inst(X)', t_ops, t_wrt)
     134  !
     135  !  Vents V
     136  !
     137  CALL histdef(histvid, 'v', 'vent v', 'm/s', &
     138        iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &
     139        32, 'inst(X)', t_ops, t_wrt)
     140
     141  !
     142  !  Temperature potentielle
     143  !
     144  CALL histdef(histid, 'teta', 'temperature potentielle', '-', &
     145        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     146        32, 'inst(X)', t_ops, t_wrt)
     147  !
     148  !  Geopotentiel
     149  !
     150  CALL histdef(histid, 'phi', 'geopotentiel', '-', &
     151        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     152        32, 'inst(X)', t_ops, t_wrt)
     153  !
     154  !  Traceurs
     155  !
     156
     157  !    DO iq=1,nqtot
     158  !      CALL histdef(histid, tracers(iq)%name,
     159  !                           tracers(iq)%longName, '-',
     160  ! .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
     161  ! .             32, 'inst(X)', t_ops, t_wrt)
     162  !    enddo
     163  !C
     164  !  Masse
     165  !
     166  CALL histdef(histid, 'masse', 'masse', 'kg', &
     167        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     168        32, 'inst(X)', t_ops, t_wrt)
     169  !
     170  !  Pression au sol
     171  !
     172  CALL histdef(histid, 'ps', 'pression naturelle au sol', 'Pa', &
     173        iip1, jjp1, thoriid, 1, 1, 1, -99, &
     174        32, 'inst(X)', t_ops, t_wrt)
     175  !
     176  !  Geopotentiel au sol
     177  !C
     178  !  CALL histdef(histid, 'phis', 'geopotentiel au sol', '-',
     179  ! .             iip1, jjp1, thoriid, 1, 1, 1, -99,
     180  ! .             32, 'inst(X)', t_ops, t_wrt)
     181  !C
     182  !  Fin
     183  !
     184  CALL histend(histid)
     185  CALL histend(histuid)
     186  CALL histend(histvid)
    188187#else
    189 ! tell the user this routine should be run with ioipsl
    190       write(lunout,*)"inithist: Warning this routine should not be",
    191      &               " used without ioipsl"
     188  ! tell the user this routine should be run with ioipsl
     189  write(lunout, *)"inithist: Warning this routine should not be", &
     190          " used without ioipsl"
    192191#endif
    193 ! of #ifdef CPP_IOIPSL
    194       return
    195       end
     192  ! of #ifdef CPP_IOIPSL
     193  return
     194end subroutine inithist

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inter_barxy_m.F90

    r5099 r5101  
    5757         "inter_barxy jnterfd")
    5858    jmods = size(champint, 2)
    59     call assert(size(champ, 1) == size(dlonid), "inter_barxy size(champ, 1)")
    60     call assert((/size(rlonimod), size(champint, 1)/) == iim, &
     59    CALL assert(size(champ, 1) == size(dlonid), "inter_barxy size(champ, 1)")
     60    CALL assert((/size(rlonimod), size(champint, 1)/) == iim, &
    6161         "inter_barxy iim")
    62     call assert(any(jmods == (/jjm, jjm + 1/)), 'inter_barxy jmods')
    63     call assert(size(rlatimod) == jjm, "inter_barxy size(rlatimod)")
     62    CALL assert(any(jmods == (/jjm, jjm + 1/)), 'inter_barxy jmods')
     63    CALL assert(size(rlatimod) == jjm, "inter_barxy size(rlatimod)")
    6464
    6565    ! Check decreasing order for "rlatimod":
    … …  
    323323    !------------------------------------
    324324
    325     call assert(size(yjdat) == size(fdat), "inter_bary")
     325    CALL assert(size(yjdat) == size(fdat), "inter_bary")
    326326
    327327    ! Initialisation des variables

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/pentes_ini.F

    r5099 r5101  
    257257         enddo
    258258      endif
    259       call limx(s0,sx,sm,pente_max)
    260 c     call minmaxq(zq,1.e33,-1.e33,'avant advx     ')
    261        call advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf)
    262 c     call minmaxq(zq,1.e33,-1.e33,'avant advy     ')
     259      CALL limx(s0,sx,sm,pente_max)
     260c     CALL minmaxq(zq,1.e33,-1.e33,'avant advx     ')
     261       CALL advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf)
     262c     CALL minmaxq(zq,1.e33,-1.e33,'avant advy     ')
    263263      if (mode==4) then
    264264         do l=1,llm
    … …  
    271271         enddo
    272272      endif
    273        call   limy(s0,sy,sm,pente_max)
    274        call advy( limit,.5*dtvr,pbarv,sm,s0,sx,sy,sz )
    275 c     call minmaxq(zq,1.e33,-1.e33,'avant advz     ')
     273       CALL   limy(s0,sy,sm,pente_max)
     274       CALL advy( limit,.5*dtvr,pbarv,sm,s0,sx,sy,sz )
     275c     CALL minmaxq(zq,1.e33,-1.e33,'avant advz     ')
    276276       do j=1,jjp1
    277277          do i=1,iip1
    … …  
    280280          enddo
    281281       enddo
    282        call limz(s0,sz,sm,pente_max)
    283        call advz( limit,dtvr,w,sm,s0,sx,sy,sz )
     282       CALL limz(s0,sz,sm,pente_max)
     283       CALL advz( limit,dtvr,w,sm,s0,sx,sy,sz )
    284284      if (mode==4) then
    285285         do l=1,llm
    … …  
    292292         enddo
    293293      endif
    294         call limy(s0,sy,sm,pente_max)
    295        call advy( limit,.5*dtvr,pbarv,sm,s0,sx,sy,sz )
     294        CALL limy(s0,sy,sm,pente_max)
     295       CALL advy( limit,.5*dtvr,pbarv,sm,s0,sx,sy,sz )
    296296       do l=1,llm
    297297          do j=1,jjp1
    … …  
    305305
    306306
    307 c     call minmaxq(zq,1.e33,-1.e33,'avant advx     ')
     307c     CALL minmaxq(zq,1.e33,-1.e33,'avant advx     ')
    308308      if (mode==4) then
    309309         do l=1,llm
    … …  
    316316         enddo
    317317      endif
    318        call limx(s0,sx,sm,pente_max)
    319        call advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf)
    320 c     call minmaxq(zq,1.e33,-1.e33,'apres advx     ')
     318       CALL limx(s0,sx,sm,pente_max)
     319       CALL advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf)
     320c     CALL minmaxq(zq,1.e33,-1.e33,'apres advx     ')
    321321c      do l=1,llm
    322322c         do j=1,jjp1

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ppm3d.F

    r5099 r5101  
    2424C
    2525C Purpose: given horizontal winds on  a hybrid sigma-p surfaces,
    26 C          one call to tpcore updates the 3-D mixing ratio
     26C          one CALL to tpcore updates the 3-D mixing ratio
    2727C          fields one time step (NDT). [vertical mass flux is computed
    2828C          internally consistent with the discretized hydrostatic mass
    … …  
    355355      if(IGD==0) then
    356356C Compute analytic cosine at cell edges
    357             call cosa(cosp,cose,JNP,PI,DP)
     357            CALL cosa(cosp,cose,JNP,PI,DP)
    358358      else
    359359C Define cosine consistent with GEOS-GCM (using dycore2.0 or later)
    360             call cosc(cosp,cose,JNP,PI,DP)
     360            CALL cosc(cosp,cose,JNP,PI,DP)
    361361      endif
    362362C
    … …  
    455455      if(IGD==0) then
    456456C Convert winds on A-Grid to Courant # on C-Grid.
    457       call A2C(U(1,1,k),V(1,1,k),IMR,JMR,j1,j2,CRX,CRY,dtdx5,DTDY5)
     457      CALL A2C(U(1,1,k),V(1,1,k),IMR,JMR,j1,j2,CRX,CRY,dtdx5,DTDY5)
    458458      else
    459459C Convert winds on C-grid to Courant #
    … …  
    674674                jad = 1
    675675        endif
    676       call xadv(IMR,JNP,j1,j2,wk1(1,1,2),UA,JS,JN,IML,DC2,iad)
    677       call yadv(IMR,JNP,j1,j2,wk1(1,1,1),VA,PV,W,jad)
     676      CALL xadv(IMR,JNP,j1,j2,wk1(1,1,2),UA,JS,JN,IML,DC2,iad)
     677      CALL yadv(IMR,JNP,j1,j2,wk1(1,1,1),VA,PV,W,jad)
    678678      do j=1,JNP
    679679      do i=1,IMR
    … …  
    683683      endif
    684684C
    685       call xtp(IMR,JNP,IML,j1,j2,JN,JS,PU,DQ(1,1,k,IC),wk1(1,1,2)
     685      CALL xtp(IMR,JNP,IML,j1,j2,JN,JS,PU,DQ(1,1,k,IC),wk1(1,1,2)
    686686     &        ,CRX,fx1,xmass,IORD)
    687687
    688       call ytp(IMR,JNP,j1,j2,acosp,RCAP,DQ(1,1,k,IC),wk1(1,1,1),CRY,
     688      CALL ytp(IMR,JNP,j1,j2,acosp,RCAP,DQ(1,1,k,IC),wk1(1,1,1),CRY,
    689689     &  DC2,ymass,WK1(1,1,3),wk1(1,1,4),WK1(1,1,5),WK1(1,1,6),JORD)
    690690C
    … …  
    746746C****6***0*********0*********0*********0*********0*********0**********72
    747747   
    748       call FZPPM(IMR,JNP,NLAY,j1,DQ(1,1,1,IC),W,Q(1,1,1,IC),WK1,DPI,
     748      CALL FZPPM(IMR,JNP,NLAY,j1,DQ(1,1,1,IC),W,Q(1,1,1,IC),WK1,DPI,
    749749     &           DC2,CRX,CRY,PU,PV,xmass,ymass,delp1,KRD)
    750750C
    751751   
    752       if(fill) call qckxyz(DQ(1,1,1,IC),DC2,IMR,JNP,NLAY,j1,j2,
     752      if(fill) CALL qckxyz(DQ(1,1,1,IC),DC2,IMR,JNP,NLAY,j1,j2,
    753753     &                     cosp,acosp,.false.,IC,NSTEP)
    754754C
    … …  
    921921C****6***0*********0*********0*********0*********0*********0**********72
    922922C Top & Bot always monotonic
    923       call lmtppm(flux(1,1),A6(1,1),AR(1,1),AL(1,1),wk1(1,1),IMR,0)
    924       call lmtppm(flux(1,NLAY),A6(1,NLAY),AR(1,NLAY),AL(1,NLAY),
     923      CALL lmtppm(flux(1,1),A6(1,1),AR(1,1),AL(1,1),wk1(1,1),IMR,0)
     924      CALL lmtppm(flux(1,NLAY),A6(1,NLAY),AR(1,NLAY),AL(1,NLAY),
    925925     &            wk1(1,NLAY),IMR,0)
    926926C
    927927C Interior depending on KORD
    928928      if(LMT<=2)
    929      &  call lmtppm(flux(1,2),A6(1,2),AR(1,2),AL(1,2),wk1(1,2),
     929     &  CALL lmtppm(flux(1,2),A6(1,2),AR(1,2),AL(1,2),wk1(1,2),
    930930     &              IMR*(NLAY-2),LMT)
    931931C
    … …  
    10041004      END DO
    10051005      ELSE
    1006       call xmist(IMR,IML,Qtmp,DC)
     1006      CALL xmist(IMR,IML,Qtmp,DC)
    10071007      DC(0) = DC(IMR)
    10081008C
    … …  
    10131013      END DO
    10141014      else
    1015       call fxppm(IMR,IML,UC(1,j),Qtmp,DC,fx1,IORD)
     1015      CALL fxppm(IMR,IML,UC(1,j),Qtmp,DC,fx1,IORD)
    10161016      endif
    10171017C
    … …  
    10411041      END DO
    10421042      ELSE
    1043       call xmist(IMR,IML,Qtmp,DC)
     1043      CALL xmist(IMR,IML,Qtmp,DC)
    10441044C
    10451045      do i=-IML,0
    … …  
    11321132      END DO
    11331133C
    1134       if(LMT<=2) call lmtppm(DC(1),A6(1),AR(1),AL(1),P(1),IMR,LMT)
     1134      if(LMT<=2) CALL lmtppm(DC(1),A6(1),AR(1),AL(1),P(1),IMR,LMT)
    11351135C
    11361136      AL(0) = AL(IMR)
    … …  
    11891189      else
    11901190   
    1191       call ymist(IMR,JNP,j1,P,DC2,4)
     1191      CALL ymist(IMR,JNP,j1,P,DC2,4)
    11921192C
    11931193      if(JORD<=0 .or. JORD>=3) then
    11941194   
    1195       call fyppm(VC,P,DC2,fx,IMR,JNP,j1,j2,A6,AR,AL,JORD)
     1195      CALL fyppm(VC,P,DC2,fx,IMR,JNP,j1,j2,A6,AR,AL,JORD)
    11961196   
    11971197      else
    … …  
    13841384      END DO
    13851385C
    1386       if(LMT<=2) call lmtppm(DC(1,j11),A6(1,j11),AR(1,j11)
     1386      if(LMT<=2) CALL lmtppm(DC(1,j11),A6(1,j11),AR(1,j11)
    13871387     &                       ,AL(1,j11),P(1,j11),len,LMT)
    13881388C
    … …  
    17611761      L = 1
    17621762        icr = 1
    1763       call filns(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
     1763      CALL filns(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
    17641764      if(ipy==0) goto 50
    1765       call filew(q(1,1,L),qtmp,IMR,JNP,j1,j2,ipx,tiny)
     1765      CALL filew(q(1,1,L),qtmp,IMR,JNP,j1,j2,ipx,tiny)
    17661766      if(ipx==0) goto 50
    17671767C
    17681768      if(cross) then
    1769       call filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
     1769      CALL filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
    17701770      endif
    17711771      if(icr==0) goto 50
    … …  
    17841784      icr = 1
    17851785C
    1786       call filns(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
     1786      CALL filns(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
    17871787      if(ipy==0) goto 225
    1788       call filew(q(1,1,L),qtmp,IMR,JNP,j1,j2,ipx,tiny)
     1788      CALL filew(q(1,1,L),qtmp,IMR,JNP,j1,j2,ipx,tiny)
    17891789      if(ipx==0) go to 225
    17901790      if(cross) then
    1791       call filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
     1791      CALL filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
    17921792      endif
    17931793      if(icr==0) goto 225
    … …  
    18151815      L = NLAY
    18161816C
    1817       call filns(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
     1817      CALL filns(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
    18181818      if(ipy==0) goto 911
    1819       call filew(q(1,1,L),qtmp,IMR,JNP,j1,j2,ipx,tiny)
     1819      CALL filew(q(1,1,L),qtmp,IMR,JNP,j1,j2,ipx,tiny)
    18201820      if(ipx==0) goto 911
    18211821C
    1822       call filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
     1822      CALL filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
    18231823      if(icr==0) goto 911
    18241824C

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/prather.F

    r5099 r5101  
    147147c-----------------------------------------------------------
    148148       do indice =1,nt
    149        call advxp( limit,0.5*dt,pbaru,sm,s0,sx,sy,sz
     149       CALL advxp( limit,0.5*dt,pbaru,sm,s0,sx,sy,sz
    150150     .             ,sxx,sxy,sxz,syy,syz,szz,1 )
    151151        END DO
    … …  
    157157        enddo
    158158c---------------------------------------------------------
    159        call advyp( limit,.5*dt*nt,pbarv,sm,s0,sx,sy,sz
     159       CALL advyp( limit,.5*dt*nt,pbarv,sm,s0,sx,sy,sz
    160160     .             ,sxx,sxy,sxz,syy,syz,szz,1 )
    161161c---------------------------------------------------------
    … …  
    174174          enddo
    175175       enddo
    176        call advzp( limit,dt*nt,w,sm,s0,sx,sy,sz
     176       CALL advzp( limit,dt*nt,w,sm,s0,sx,sy,sz
    177177     .             ,sxx,sxy,sxz,syy,syz,szz,1 )
    178178        do l=1,llm
    … …  
    186186
    187187c---------------------------------------------------------
    188        call advyp( limit,.5*dt*nt,pbarv,sm,s0,sx,sy,sz
     188       CALL advyp( limit,.5*dt*nt,pbarv,sm,s0,sx,sy,sz
    189189     .             ,sxx,sxy,sxz,syy,syz,szz,1 )
    190190c---------------------------------------------------------
    … …  
    204204       ENDDO
    205205       do indice=1,nt
    206        call advxp( limit,0.5*dt,pbaru,sm,s0,sx,sy,sz
     206       CALL advxp( limit,0.5*dt,pbaru,sm,s0,sx,sy,sz
    207207     .             ,sxx,sxy,sxz,syy,syz,szz,1 )
    208208        END DO

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/rotatf.F

    r5099 r5101  
    99c     a tous les niveaux d'1 vecteur de comp. x et y ..
    1010c       x  et  y etant des composantes  covariantes  ...
    11 c     Only difference with rotat: call to filtreg.
     11c     Only difference with rotat: CALL to filtreg.
    1212c********************************************************************
    1313c   klevel, x  et y   sont des arguments d'entree pour le s-prog

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/test_period.F

    r5099 r5101  
    99c                           teta, q , p et phis                 ..........
    1010c
    11       USE infotrac, ONLY : nqtot
     11      USE infotrac, ONLY: nqtot
    1212c
    1313c     IMPLICIT NONE

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ugeostr.F90

    r5099 r5101  
    4848     ENDDO
    4949  ENDDO
    50   call dump2d(jjm,llm,um,'Vent-u geostrophique')
     50  CALL dump2d(jjm,llm,um,'Vent-u geostrophique')
    5151
    5252  !   calcul des champ de vent:

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/write_grads_dyn.h

    r5099 r5101  
    55
    66         string10='dyn'
    7          call inigrads(1,iip1
     7         CALL inigrads(1,iip1
    88     s  ,rlonv,180./pi,-180.,180.,jjp1,rlatu,-90.,90.,180./pi
    99     s  ,llm,presnivs,1.

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writedynav.F90

    r4046 r5101  
    66  USE ioipsl
    77#endif
    8   USE infotrac, ONLY : nqtot
    9   use com_io_dyn_mod, only : histaveid, histvaveid, histuaveid
     8  USE infotrac, ONLY: nqtot
     9  use com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
    1010  USE comconst_mod, ONLY: cpp
    1111  USE temps_mod, ONLY: itau_dyn
    … …  
    7171
    7272  ! Passage aux composantes naturelles du vent
    73   call covnat(llm, ucov, vcov, unat, vnat)
     73  CALL covnat(llm, ucov, vcov, unat, vnat)
    7474
    7575  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
    … …  
    7777  !  Vents U
    7878
    79   call histwrite(histuaveid, 'u', itau_w, unat,  &
     79  CALL histwrite(histuaveid, 'u', itau_w, unat,  &
    8080       iip1*jjp1*llm, ndexu)
    8181
    8282  !  Vents V
    8383
    84   call histwrite(histvaveid, 'v', itau_w, vnat,  &
     84  CALL histwrite(histvaveid, 'v', itau_w, vnat,  &
    8585       iip1*jjm*llm, ndexv)
    8686
    8787  !  Temperature potentielle moyennee
    8888
    89   call histwrite(histaveid, 'theta', itau_w, teta,  &
     89  CALL histwrite(histaveid, 'theta', itau_w, teta,  &
    9090       iip1*jjp1*llm, ndexu)
    9191
    … …  
    9595     tm(ii) = teta(ii) * ppk(ii)/cpp
    9696  enddo
    97   call histwrite(histaveid, 'temp', itau_w, tm,  &
     97  CALL histwrite(histaveid, 'temp', itau_w, tm,  &
    9898       iip1*jjp1*llm, ndexu)
    9999
    100100  !  Geopotentiel
    101101
    102   call histwrite(histaveid, 'phi', itau_w, phi,  &
     102  CALL histwrite(histaveid, 'phi', itau_w, phi,  &
    103103       iip1*jjp1*llm, ndexu)
    104104
    … …  
    106106
    107107  !  DO iq=1, nqtot
    108   !       call histwrite(histaveid, tracers(iq)%longName, itau_w, &
     108  !       CALL histwrite(histaveid, tracers(iq)%longName, itau_w, &
    109109  !                   q(:, :, iq), iip1*jjp1*llm, ndexu)
    110110  ! enddo
    … …  
    112112  !  Masse
    113113
    114   call histwrite(histaveid, 'masse', itau_w, masse,  &
     114  CALL histwrite(histaveid, 'masse', itau_w, masse,  &
    115115       iip1*jjp1*llm, ndexu)
    116116
    117117  !  Pression au sol
    118118
    119   call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
     119  CALL histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
    120120
    121121  ! Geopotentiel au sol
    122122
    123   ! call histwrite(histaveid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
     123  ! CALL histwrite(histaveid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
    124124
    125125  if (ok_sync) then
    126      call histsync(histaveid)
    127      call histsync(histvaveid)
    128      call histsync(histuaveid)
     126     CALL histsync(histaveid)
     127     CALL histsync(histvaveid)
     128     CALL histsync(histuaveid)
    129129  ENDIF
    130130

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writehist.F

    r5099 r5101  
    77      USE ioipsl
    88#endif
    9       USE infotrac, ONLY : nqtot
    10       use com_io_dyn_mod, only : histid,histvid,histuid
     9      USE infotrac, ONLY: nqtot
     10      use com_io_dyn_mod, ONLY: histid,histvid,histuid
    1111      USE temps_mod, ONLY: itau_dyn
    1212     
    … …  
    7272      itau_w = itau_dyn + time
    7373!  Passage aux composantes naturelles du vent
    74       call covnat(llm, ucov, vcov, unat, vnat)
     74      CALL covnat(llm, ucov, vcov, unat, vnat)
    7575C
    7676C  Appels a histwrite pour l'ecriture des variables a sauvegarder
    … …  
    7878C  Vents U
    7979C
    80       call histwrite(histuid, 'u', itau_w, unat,
     80      CALL histwrite(histuid, 'u', itau_w, unat,
    8181     .               iip1*jjp1*llm, ndexu)
    8282C
    8383C  Vents V
    8484C
    85       call histwrite(histvid, 'v', itau_w, vnat,
     85      CALL histwrite(histvid, 'v', itau_w, vnat,
    8686     .               iip1*jjm*llm, ndexv)
    8787
    … …  
    8989C  Temperature potentielle
    9090C
    91       call histwrite(histid, 'teta', itau_w, teta,
     91      CALL histwrite(histid, 'teta', itau_w, teta,
    9292     .                iip1*jjp1*llm, ndexu)
    9393C
    9494C  Geopotentiel
    9595C
    96       call histwrite(histid, 'phi', itau_w, phi,
     96      CALL histwrite(histid, 'phi', itau_w, phi,
    9797     .                iip1*jjp1*llm, ndexu)
    9898C
    … …  
    100100C
    101101!        DO iq=1,nqtot
    102 !          call histwrite(histid, tracers(iq)%longName, itau_w,
     102!          CALL histwrite(histid, tracers(iq)%longName, itau_w,
    103103!     .                   q(:,:,iq), iip1*jjp1*llm, ndexu)
    104104!        enddo
    … …  
    106106C  Masse
    107107C
    108       call histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
     108      CALL histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
    109109C
    110110C  Pression au sol
    111111C
    112       call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
     112      CALL histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
    113113C
    114114C  Geopotentiel au sol
    115115C
    116 !      call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
     116!      CALL histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
    117117C
    118118C  Fin
    119119C
    120120      if (ok_sync) then
    121         call histsync(histid)
    122         call histsync(histvid)
    123         call histsync(histuid)
     121        CALL histsync(histid)
     122        CALL histsync(histvid)
     123        CALL histsync(histuid)
    124124      endif
    125125#else
Note: See TracChangeset for help on using the changeset viewer.