Ignore:
Timestamp:
Jul 22, 2024, 9:29:09 PM (2 months ago)
Author:
abarral
Message:

Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90
Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad
Create lmdz_yoerad.f90
(lint) Remove "!" on otherwise empty line

Location:
LMDZ6/branches/Amaury_dev/libf/dyn3dmem
Files:
57 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/abort_gcm.F

    r5082 r5099  
    1 !
     1
    22! $Id: abort_gcm.F 1747 2013-04-23 14:06:30Z lguez $
    3 !
     3
    44c
    55c

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/addfi_loc.F

    r2598 r5099  
    1 !
     1
    22! $Id$
    3 !
     3
    44      SUBROUTINE addfi_loc(pdt, leapf, forward,
    55     S          pucov, pvcov, pteta, pq   , pps ,

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advect_new_loc.F

    r5086 r5099  
    1 !
     1
    22! $Header$
    3 !
     3
    44      SUBROUTINE advect_new_loc(ucov,vcov,teta,w,massebx,masseby,
    55     &                        du,dv,dteta)

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

    r5082 r5099  
    44SUBROUTINE advtrac_loc(pbarug, pbarvg, wg, p, massem, q, teta, pk)
    55   !     Auteur :  F. Hourdin
    6    !
     6
    77   !     Modif. P. Le Van     (20/12/97)
    88   !            F. Codron     (10/99)
    99   !            D. Le Croller (07/2001)
    1010   !            M.A Filiberti (04/2002)
    11    !
     11
    1212   USE infotrac,     ONLY: nqtot, tracers
    1313   USE control_mod,  ONLY: iapp_tracvl, day_step, planet_type
    … …  
    2323
    2424   IMPLICIT NONE
    25    !
     25
    2626   include "dimensions.h"
    2727   include "paramet.h"
    … …  
    122122#endif
    123123
    124 !         
    125124!  CALL Register_Hallo_v(pbarvg,llm,1,1,1,1,TestRequest)
    126125!  CALL SendRequest(TestRequest)

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

    r5090 r5099  
    1 !
     1
    22! $Id$
    3 !
     3
    44  module Bands
    55  USE parallel_lmdz

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bilan_dyn_loc.F

    r5093 r5099  
    1 !
     1
    22! $Id: bilan_dyn_p.F 1299 2010-01-20 14:27:21Z fairhead $
    3 !
     3
    44      SUBROUTINE bilan_dyn_loc (ntrac,dt_app,dt_cum,
    55     s  ps,masse,pk,flux_u,flux_v,teta,phi,ucov,vcov,trac)

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caladvtrac_loc.F

    r5082 r5099  
    1 !
     1
    22! $Id: caladvtrac_p.F 1299 2010-01-20 14:27:21Z fairhead $
    3 !
     3
    44c
    55c

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/caldyn_loc.F

    r5082 r5099  
    1 !
     1
    22! $Id: $
    3 !
     3
    44#undef DEBUG_IO
    55!#define DEBUG_IO
    … …  
    1717
    1818!=======================================================================
    19 !
     19
    2020!  Auteur :  P. Le Van
    21 !
     21
    2222!   Objet:
    2323!   ------
    24 !
     24
    2525!   Calcul des tendances dynamiques.
    26 !
     26
    2727! Modif 04/93 F.Forget
    2828!=======================================================================

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

    r3435 r5099  
    222222!    .......        P. Le Van (  ajout  le 17/04/96  )   ...........
    223223!   ...      Calcul de la valeur moyenne, unique de h aux poles  .....
    224 !
    225224
    226225    ijb=ij_begin

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

    r2603 r5099  
    11SUBROUTINE convmas1_loc (pbaru, pbarv, convm)
    2 !
     2
    33!-------------------------------------------------------------------------------
    44! Authors: P. Le Van , Fr. Hourdin.

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

    r2603 r5099  
    11SUBROUTINE convmas2_loc (convm)
    2 !
     2
    33!-------------------------------------------------------------------------------
    44! Authors: P. Le Van , Fr. Hourdin.

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

    r2603 r5099  
    11SUBROUTINE convmas_loc (pbaru, pbarv, convm)
    2 !
     2
    33!-------------------------------------------------------------------------------
    44! Authors: P. Le Van , Fr. Hourdin.

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covnat_loc.F

    r4593 r5099  
    1 !
     1
    22! $Header$
    3 !
     3
    44      SUBROUTINE covnat_loc(klevel,ucov, vcov, unat, vnat )
    55      USE parallel_lmdz

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dissip_loc.F

    r2597 r5099  
    1 !
     1
    22! $Id: $
    3 !
     3
    44      SUBROUTINE dissip_loc( vcov,ucov,teta,p, dv,du,dh )
    55c

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

    r5091 r5099  
    11SUBROUTINE dynetat0_loc(fichnom,vcov,ucov,teta,q,masse,ps,phis,time)
    2 !
     2
    33!-------------------------------------------------------------------------------
    44! Authors: P. Le Van , L.Fairhead
    … …  
    99  USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName
    1010  USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str, strIdx
    11   USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQUIRE_DIMENSION, NF90_INQ_VARID, &
    12                          NF90_CLOSE, NF90_GET_VAR, NF90_INQUIRE_VARIABLE,  NF90_NoErr
     11  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, nf90_inquire_dimension, NF90_INQ_VARID, &
     12                         NF90_CLOSE, nf90_get_var, NF90_INQUIRE_VARIABLE,  nf90_noerr
    1313  USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
    1414  USE control_mod, ONLY: planet_type
    … …  
    8787  pa         = tab_cntrl(idecal+13)
    8888  preff      = tab_cntrl(idecal+14)
    89 !
     89
    9090  clon       = tab_cntrl(idecal+15)
    9191  clat       = tab_cntrl(idecal+16)
    9292  grossismx  = tab_cntrl(idecal+17)
    9393  grossismy  = tab_cntrl(idecal+18)
    94 !
     94
    9595  IF ( tab_cntrl(idecal+19)==1. )  THEN
    9696    fxyhypb  = .TRUE.
    … …  
    122122
    123123  var="temps"
    124   IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN
     124  IF(NF90_INQ_VARID(fID,var,vID)/=nf90_noerr) THEN
    125125    CALL msg('missing field <temps> ; trying with <Time>', modname)
    126126    var="Time"
    127127    CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
    128128  END IF
    129   CALL err(NF90_GET_VAR(fID,vID,time),"get",var)
     129  CALL err(nf90_get_var(fID,vID,time),"get",var)
    130130
    131131  ALLOCATE(phis_glo(ip1jmp1))
    … …  
    157157  ll = .FALSE.
    158158#ifdef REPROBUS
    159   ll = NF90_INQ_VARID(fID, 'HNO3tot', vID) /= NF90_NoErr                                 !--- DETECT OLD REPRO start.nc FILE
     159  ll = NF90_INQ_VARID(fID, 'HNO3tot', vID) /= nf90_noerr                                 !--- DETECT OLD REPRO start.nc FILE
    160160#endif
    161161  DO iq=1,nqtot
    … …  
    170170    END IF
    171171    !--------------------------------------------------------------------------------------------------------------------------
    172     IF(NF90_INQ_VARID(fID, var, vID) == NF90_NoErr .AND. .NOT.lSkip) THEN                !=== REGULAR CASE: AVAILABLE VARIABLE
     172    IF(NF90_INQ_VARID(fID, var, vID) == nf90_noerr .AND. .NOT.lSkip) THEN                !=== REGULAR CASE: AVAILABLE VARIABLE
    173173      CALL get_var2(var,q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)
    174174    !--------------------------------------------------------------------------------------------------------------------------
    175     ELSE IF(NF90_INQ_VARID(fID, oldVar, vID) == NF90_NoErr) THEN                         !=== TRY WITH ALTERNATE NAME
     175    ELSE IF(NF90_INQ_VARID(fID, oldVar, vID) == nf90_noerr) THEN                         !=== TRY WITH ALTERNATE NAME
    176176      CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to <'//TRIM(oldVar)//'>', modname)
    177177      CALL get_var2(oldVar, q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)
    … …  
    241241  ierr=NF90_INQUIRE_VARIABLE(fID,vID,ndims=nd)
    242242  IF(nd==1) THEN
    243     CALL err(NF90_GET_VAR(fID,vID,v),"get",var); RETURN
     243    CALL err(nf90_get_var(fID,vID,v),"get",var); RETURN
    244244  END IF
    245245  ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids)
    246   DO k=1,nd; ierr=NF90_INQUIRE_DIMENSION(fID,dids(k),len=nn(k)); END DO
     246  DO k=1,nd; ierr=nf90_inquire_dimension(fID,dids(k),len=nn(k)); END DO
    247247  ntot=PRODUCT(nn(1:nd))
    248248  SELECT CASE(nd)
    249249    CASE(2); ALLOCATE(w2(nn(1),nn(2)))
    250       CALL err(NF90_GET_VAR(fID,vID,w2),"get",var)
     250      CALL err(nf90_get_var(fID,vID,w2),"get",var)
    251251      v=RESHAPE(w2,[ntot]); DEALLOCATE(w2)
    252252    CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3)))
    253       CALL err(NF90_GET_VAR(fID,vID,w3),"get",var)
     253      CALL err(nf90_get_var(fID,vID,w3),"get",var)
    254254      v=RESHAPE(w3,[ntot]); DEALLOCATE(w3)
    255255  END SELECT
    … …  
    267267
    268268  IF(nd==1) THEN
    269     CALL err(NF90_GET_VAR(fID,vID,v),"get",var); RETURN
     269    CALL err(nf90_get_var(fID,vID,v),"get",var); RETURN
    270270  END IF
    271271  ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids)
    272272
    273   DO k=1,nd; ierr=NF90_INQUIRE_DIMENSION(fID,dids(k),len=nn(k)); END DO
     273  DO k=1,nd; ierr=nf90_inquire_dimension(fID,dids(k),len=nn(k)); END DO
    274274
    275275  SELECT CASE(nd)
    276276  CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3)))
    277      CALL err(NF90_GET_VAR(fID,vID,w3),"get",var)
     277     CALL err(nf90_get_var(fID,vID,w3),"get",var)
    278278     v=RESHAPE(w3,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w3)
    279279  CASE(4);  ALLOCATE(w4(nn(1),nn(2),nn(3),nn(4)))
    280      CALL err(NF90_GET_VAR(fID,vID,w4),"get",var)
     280     CALL err(nf90_get_var(fID,vID,w4),"get",var)
    281281     v=RESHAPE(w4,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w4)
    282282  END SELECT
    … …  
    288288  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
    289289  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
    290   IF(ierr==NF90_NoERR) RETURN
     290  IF(ierr==nf90_noerr) RETURN
    291291  SELECT CASE(typ)
    292292    CASE('inq');   mesg="Field <"//TRIM(nam)//"> is missing"

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

    r5088 r5099  
    11SUBROUTINE dynredem0_loc(fichnom,iday_end,phis)
    2 !
     2
    33!-------------------------------------------------------------------------------
    44! Write the NetCDF restart file (initialization).
    … …  
    8989  tab_cntrl(22) = grossismx
    9090  tab_cntrl(23) = grossismy
    91 !
     91
    9292  IF ( fxyhypb )   THEN
    9393    tab_cntrl(24) = 1.
    … …  
    162162
    163163END SUBROUTINE dynredem0_loc
    164 !
    165 !-------------------------------------------------------------------------------
    166 
    167 
    168 !-------------------------------------------------------------------------------
    169 !
     164
     165!-------------------------------------------------------------------------------
     166
     167
     168!-------------------------------------------------------------------------------
     169
    170170SUBROUTINE dynredem1_loc(fichnom,time,vcov,ucov,teta,q,masse,ps)
    171 !
     171
    172172!-------------------------------------------------------------------------------
    173173! Purpose: Write the NetCDF restart file (append).
    … …  
    178178  USE infotrac, ONLY: nqtot, tracers, type_trac
    179179  USE control_mod
    180   USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &
    181                       NF90_CLOSE, NF90_WRITE,   NF90_PUT_VAR, NF90_NoErr
     180  USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, nf90_get_var, NF90_INQ_VARID,  &
     181                      NF90_CLOSE, NF90_WRITE,   NF90_PUT_VAR, nf90_noerr
    182182  USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, &
    183183                          err, modname, fil, msg
    … …  
    225225  var="controle"
    226226  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
    227   CALL err(NF90_GET_VAR(nid,vID,tab_cntrl),"get",var)
     227  CALL err(nf90_get_var(nid,vID,tab_cntrl),"get",var)
    228228  tab_cntrl(31)=DBLE(itau_dyn + itaufin)
    229229  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
    … …  
    254254      fil="start_trac.nc"
    255255      ierr=NF90_INQ_VARID(nid_trac,var,vID_trac)
    256       dum='inq'; IF(ierr==NF90_NoErr) dum='fnd'
     256      dum='inq'; IF(ierr==nf90_noerr) dum='fnd'
    257257      WRITE(lunout,*)msg(dum,var)
    258258!$OMP END MASTER
    259259!$OMP BARRIER
    260       IF(ierr==NF90_NoErr) CALL dynredem_read_u(nid_trac,var,q(:,:,iq),llm)
     260      IF(ierr==nf90_noerr) CALL dynredem_read_u(nid_trac,var,q(:,:,iq),llm)
    261261    END IF
    262262    fil=fichnom

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

    r5090 r5099  
    1818
    1919!===============================================================================
    20 !
     20
    2121SUBROUTINE dynredem_write_u(ncid,id,var,ll)
    22 !
     22
    2323!===============================================================================
    2424  IMPLICIT NONE
    … …  
    6363 
    6464END SUBROUTINE dynredem_write_u
    65 !
    66 !===============================================================================
    67 
    68 
    69 !===============================================================================
    70 !
     65
     66!===============================================================================
     67
     68
     69!===============================================================================
     70
    7171SUBROUTINE dynredem_write_v(ncid,id,var,ll)
    72 !
     72
    7373!===============================================================================
    7474  IMPLICIT NONE
    … …  
    113113 
    114114END SUBROUTINE dynredem_write_v
    115 !
    116 !===============================================================================
    117 
    118 
    119 !===============================================================================
    120 !
     115
     116!===============================================================================
     117
     118
     119!===============================================================================
     120
    121121SUBROUTINE dynredem_read_u(ncid,id,var,ll)
    122 !
     122
    123123!===============================================================================
    124124  IMPLICIT NONE
    … …  
    149149    !$OMP MASTER
    150150      start(3)=l
    151       CALL err(NF90_GET_VAR(ncid,nvarid,var_glo,start,count),"get",id)
     151      CALL err(nf90_get_var(ncid,nvarid,var_glo,start,count),"get",id)
    152152    !$OMP END MASTER
    153153    END IF
    … …  
    165165 
    166166END SUBROUTINE dynredem_read_u   
    167 !
    168 !===============================================================================
    169 
    170 
    171 !===============================================================================
    172 !
     167
     168!===============================================================================
     169
     170
     171!===============================================================================
     172
    173173SUBROUTINE cre_var(ncid,var,title,did,units)
    174 !
     174
    175175!===============================================================================
    176176  IMPLICIT NONE
    … …  
    187187
    188188END SUBROUTINE cre_var
    189 !
    190 !===============================================================================
    191 
    192 
    193 !===============================================================================
    194 !
     189
     190!===============================================================================
     191
     192
     193!===============================================================================
     194
    195195SUBROUTINE put_var(ncid,var,title,did,v,units)
    196 !
     196
    197197!===============================================================================
    198198  IMPLICIT NONE
    … …  
    210210  CALL err(NF90_ENDDEF(ncid))
    211211  nd=SIZE(did)
    212   DO k=1,nd; CALL err(NF90_INQUIRE_DIMENSION(ncid,did(k),len=nn(k))); END DO
     212  DO k=1,nd; CALL err(nf90_inquire_dimension(ncid,did(k),len=nn(k))); END DO
    213213  IF(nd==1) CALL err(NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:1))),var)
    214214  IF(nd==2) CALL err(NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:2))),var)
    215215  CALL err(NF90_REDEF(ncid))
    216216END SUBROUTINE put_var
    217 !
    218 !===============================================================================
    219 
    220 
    221 !===============================================================================
    222 !
     217
     218!===============================================================================
     219
     220
     221!===============================================================================
     222
    223223FUNCTION msg(typ,nam)
    224 !
     224
    225225!===============================================================================
    226226  IMPLICIT NONE
    … …  
    242242
    243243END FUNCTION msg
    244 !
    245 !===============================================================================
    246 
    247 
    248 !===============================================================================
    249 !
     244
     245!===============================================================================
     246
     247
     248!===============================================================================
     249
    250250SUBROUTINE err(ierr,typ,nam)
    251 !
     251
    252252!===============================================================================
    253253  IMPLICIT NONE
    … …  
    258258  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
    259259!===============================================================================
    260   IF(ierr==NF90_NoERR) RETURN
     260  IF(ierr==nf90_noerr) RETURN
    261261  IF(.NOT.PRESENT(typ)) THEN
    262262    CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr)
    … …  
    266266
    267267END SUBROUTINE err
    268 !
     268
    269269!===============================================================================
    270270

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

    r2336 r5099  
    11SUBROUTINE enercin_loc ( vcov, ucov, vcont, ucont, ecin )
    2 !
     2
    33!-------------------------------------------------------------------------------
    44! Authors: P. Le Van.
    … …  
    2121!                 . V
    2222!                i,j-1
    23 !
     23
    2424!      alpha4 .       . alpha1
    25 !
    26 !
     25
     26
    2727!        U .      . P     . U
    2828!       i-1,j    i,j      i,j
    29 !
     29
    3030!      alpha3 .       . alpha2
    31 !
    32 !
     31
     32
    3333!                 . V
    3434!                i,j
    35 !
     35
    3636! Kinetic energy at scalar point P(i,j) (excluding poles) is:
    3737!       Ecin = 0.5 * U(i-1,j)**2 *( alpha3 + alpha4 )  +

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

    r5082 r5099  
    99    !     Auteurs :  P.Le Van  , Fr. Hourdin  .
    1010    !    ..........
    11     !
     11
    1212    !    ....  ngrid, ps,p             sont des argum.d'entree  au sous-prog ...
    1313    !    ....  pks,pk,pkf   sont des argum.de sortie au sous-prog ...
    14     !
     14
    1515    !   ************************************************************************
    1616    !    Calcule la fonction d'Exner pk = Cp * (p/preff) ** kappa , aux milieux des
    … …  
    2020    !  .. N.B : Au sommet de l'atmosphere,  p(llm+1) = 0. , et ps et pks sont
    2121    !    la pression et la fonction d'Exner  au  sol  .
    22     !
     22
    2323    !                                 -------- z
    2424    !    A partir des relations  ( 1 ) p*dz(pk) = kappa *pk*dz(p)      et
    2525    !                            ( 2 ) pk(l) = alpha(l)+ beta(l)*pk(l-1)
    2626    !    ( voir note de Fr.Hourdin )  ,
    27     !
     27
    2828    !    on determine successivement , du haut vers le bas des couches, les
    2929    !    coef. alpha(llm),beta(llm) .,.,alpha(l),beta(l),,,alpha(2),beta(2),
    3030    !    puis pk(ij,1). Ensuite ,on calcule,du bas vers le haut des couches, 
    3131    !     pk(ij,l)  donne  par la relation (2),  pour l = 2 a l = llm .
    32     !
    33     !
     32
     33
    3434    USE parallel_lmdz
    3535    USE mod_filtreg_p
    … …  
    3939   
    4040    IMPLICIT NONE
    41     !
     41
    4242    include "dimensions.h"
    4343    include "paramet.h"
    … …  
    5959    !$OMP THREADPRIVATE(firstcall)
    6060    character(len=*),parameter :: modname="exner_hyb_loc"
    61     !
     61
    6262    !$OMP BARRIER           
    6363
    … …  
    126126
    127127    !$OMP BARRIER
    128     !
    129     !
     128
     129
    130130    !    .... Calcul des coeff. alpha et beta  pour la couche l = llm ..
    131     !
     131
    132132    !$OMP DO SCHEDULE(STATIC)
    133133    DO     ij      = ijb,ije
    … …  
    136136    ENDDO
    137137    !$OMP ENDDO NOWAIT
    138     !
     138
    139139    !     ... Calcul des coeff. alpha et beta  pour l = llm-1  a l = 2 ...
    140     !
     140
    141141    DO l = llm -1 , 2 , -1
    142        !
     142
    143143       !$OMP DO SCHEDULE(STATIC)
    144144       DO ij = ijb, ije
    … …  
    152152    !  ***********************************************************************
    153153    !     .....  Calcul de pk pour la couche 1 , pres du sol  ....
    154     !
     154
    155155    !$OMP DO SCHEDULE(STATIC)
    156156    DO   ij   = ijb, ije
    … …  
    159159    ENDDO
    160160    !$OMP ENDDO NOWAIT
    161     !
     161
    162162    !    ..... Calcul de pk(ij,l) , pour l = 2 a l = llm  ........
    163     !
     163
    164164    DO l = 2, llm
    165165       !$OMP DO SCHEDULE(STATIC)

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

    r5082 r5099  
    66
    77  SUBROUTINE  exner_milieu_loc ( ngrid, ps, p, pks, pk, pkf )
    8     !
     8
    99    !     Auteurs :  F. Forget , Y. Wanherdrick
    1010    ! P.Le Van  , Fr. Hourdin  .
    1111    !    ..........
    12     !
     12
    1313    !    ....  ngrid, ps,p             sont des argum.d'entree  au sous-prog ...
    1414    !    ....  pks,pk,pkf   sont des argum.de sortie au sous-prog ...
    15     !
     15
    1616    !   ************************************************************************
    1717    !    Calcule la fonction d'Exner pk = Cp * (p/preff) ** kappa , aux milieux des
    … …  
    2121    !  .. N.B : Au sommet de l'atmosphere,  p(llm+1) = 0. , et ps et pks sont
    2222    !    la pression et la fonction d'Exner  au  sol  .
    23     !
     23
    2424    !     WARNING : CECI est une version speciale de exner_hyb originale
    2525    !               Utilise dans la version martienne pour pouvoir
    … …  
    2828    !              energie totale/ interne / potentielle (F.Forget 2001)
    2929    !    ( voir note de Fr.Hourdin )  ,
    30     !
     30
    3131    USE parallel_lmdz
    3232    USE mod_filtreg_p
    … …  
    3535   
    3636    IMPLICIT NONE
    37     !
     37
    3838    include "dimensions.h"
    3939    include "paramet.h"
    … …  
    117117
    118118    !$OMP BARRIER
    119     !
    120     !
     119
     120
    121121    !    .... Calcul de pk  pour la couche l
    122122    !    --------------------------------------------
    123     !
     123
    124124    dum1 = cpp * (2*preff)**(-kappa)
    125125    DO l = 1, llm-1

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/filtreg_p.F

    r5091 r5099  
    411411
    412412!      DO j=1,nlat
    413 !     
     413
    414414!          PRINT *,"check FFT ----> Delta(",j,")=",
    415415!     &            sum(champ(:,j,:)-champ_fft(:,j,:))/sum(champ(:,j,:)),
    … …  
    419419!          PRINT *,"check FFT ----> Delta(",j,")=",
    420420!     &            sum(champ-champ_fft)/sum(champ)
    421 !     
    422      
     421
    423422c
    424423 1111 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau  CHAMP a

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

    r2336 r5099  
    11SUBROUTINE flumass_loc(massebx,masseby, vcont, ucont, pbaru, pbarv )
    2 !
     2
    33!-------------------------------------------------------------------------------
    44! Authors: P. Le Van , Fr. Hourdin.

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/fluxstokenc_p.F

    r5082 r5099  
    1 !
     1
    22! $Id: caladvtrac_p.F 1299 2010-01-20 14:27:21Z fairhead $
    3 !
     3
    44c
    55c

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/friction_loc.F

    r5082 r5099  
    1 !
     1
    22! $Id: friction_p.F 1299 2010-01-20 14:27:21Z fairhead $
    3 !
     3
    44c=======================================================================
    55      SUBROUTINE friction_loc(ucov,vcov,pdt)
    … …  
    1616
    1717!=======================================================================
    18 !
     18
    1919!   Friction for the Newtonian case:
    2020!   --------------------------------

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

    r5090 r5099  
    1 !
     1
    22! $Id$
    3 !
    43
    54PROGRAM gcm
    … …  
    3635
    3736  !=======================================================================
    38   !
     37
    3938  !   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
    4039  !   -------
    41   !
     40
    4241  !   Objet:
    4342  !   ------
    44   !
     43
    4544  !   GCM LMD nouvelle grille
    46   !
     45
    4746  !=======================================================================
    48   !
     47
    4948  !  ... Dans inigeom , nouveaux calculs pour les elongations  cu , cv
    5049  !      et possibilite d'appeler une fonction f(y)  a derivee tangente
    … …  
    5251  !  ... Possibilite de choisir le schema pour l'advection de
    5352  !        q  , en modifiant iadv dans traceur.def  (MAF,10/02) .
    54   !
     53
    5554  !      Pour Van-Leer + Vapeur d'eau saturee, iadv(1)=4. (F.Codron,10/99)
    5655  !      Pour Van-Leer iadv=10
    57   !
     56
    5857  !-----------------------------------------------------------------------
    5958  !   Declarations:
    … …  
    133132  !  lecture des fichiers gcm.def ou run.def
    134133  !  ---------------------------------------
    135   !
     134
    136135  CALL conf_gcm( 99, .TRUE. )
    137136  if (mod(iphysiq, iperiod) /= 0) call abort_gcm("conf_gcm", &
    138137       "iphysiq must be a multiple of iperiod", 1)
    139   !
    140   !
     138
     139
    141140  !------------------------------------
    142141  !   Initialisation partie parallele
    … …  
    270269  ENDIF
    271270
    272   !
    273271  ! on remet le calendrier \`a zero si demande
    274   !
     272
    275273  IF (start_time /= starttime) then
    276274     WRITE(lunout,*)' GCM: Attention l''heure de depart lue dans le' &
    … …  
    370368     CALL inifilr
    371369  endif ! of if (iflag_phys.eq.1)
    372   !
     370
    373371  !-----------------------------------------------------------------------
    374372  !   Initialisation de la dissipation :
    … …  
    459457
    460458  ! #endif of #ifdef CPP_IOIPSL
    461   !
     459
    462460  !-----------------------------------------------------------------------
    463461  !   Integration temporelle du modele :

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

    r2094 r5099  
    1 !
     1
    22! $Id: getparam.F90 1279 2009-12-10 09:02:56Z fairhead $
    3 !
     3
    44MODULE getparam
    55#ifdef CPP_IOIPSL
    … …  
    2020  SUBROUTINE ini_getparam(fichier)
    2121  USE parallel_lmdz
    22     !
     22
    2323    IMPLICIT NONE
    24     !
     24
    2525    CHARACTER*(*) :: fichier
    2626    IF (mpi_rank==0) OPEN(out_eff,file=fichier,status='unknown',form='formatted')
    … …  
    3030  SUBROUTINE fin_getparam
    3131  USE parallel_lmdz
    32     !
     32
    3333    IMPLICIT NONE
    34     !
     34
    3535      IF (mpi_rank==0) CLOSE(out_eff)
    3636
    … …  
    3939  SUBROUTINE getparamr(TARGET,def_val,ret_val,comment)
    4040  USE parallel_lmdz
    41     !
     41
    4242    IMPLICIT NONE
    43     !
     43
    4444    !   Get a real scalar. We first check if we find it
    4545    !   in the database and if not we get it from the run.def
    46     !
     46
    4747    !   getinr1d and getinr2d are written on the same pattern
    48     !
     48
    4949    CHARACTER*(*) :: TARGET
    5050    REAL :: def_val
    … …  
    6565  SUBROUTINE getparami(TARGET,def_val,ret_val,comment)
    6666  USE parallel_lmdz
    67     !
     67
    6868    IMPLICIT NONE
    69     !
     69
    7070    !   Get a real scalar. We first check if we find it
    7171    !   in the database and if not we get it from the run.def
    72     !
     72
    7373    !   getinr1d and getinr2d are written on the same pattern
    74     !
     74
    7575    CHARACTER*(*) :: TARGET
    7676    INTEGER :: def_val
    … …  
    9292  SUBROUTINE getparaml(TARGET,def_val,ret_val,comment)
    9393  USE parallel_lmdz
    94     !
     94
    9595    IMPLICIT NONE
    96     !
     96
    9797    !   Get a real scalar. We first check if we find it
    9898    !   in the database and if not we get it from the run.def
    99     !
     99
    100100    !   getinr1d and getinr2d are written on the same pattern
    101     !
     101
    102102    CHARACTER*(*) :: TARGET
    103103    LOGICAL :: def_val

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gr_u_scal_loc.F

    r4593 r5099  
    1 !
     1
    22! $Header$
    3 !
     3
    44      SUBROUTINE gr_u_scal_loc(nx,x_u,x_scal)
    55c%W%    %G%

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gr_v_scal_loc.F

    r4593 r5099  
    1 !
     1
    22! $Header$
    3 !
     3
    44      SUBROUTINE gr_v_scal_loc(nx,x_v,x_scal)
    55c%W%    %G%

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

    r5093 r5099  
    16531653   
    16541654             status=nf90_inq_dimid(ncidu, "LONU", dimid)
    1655              status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
     1655             status=nf90_inquire_dimension(ncidu,dimid,namedim,lendim)
    16561656             IF (lendim /= iip1) THEN
    16571657                abort_message='dimension LONU different from iip1 in u.nc'
    … …  
    16601660
    16611661             status=nf90_inq_dimid(ncidu, "LATU", dimid)
    1662              status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
     1662             status=nf90_inquire_dimension(ncidu,dimid,namedim,lendim)
    16631663             IF (lendim /= jjp1) THEN
    16641664                abort_message='dimension LATU different from jjp1 in u.nc'
    … …  
    16841684             
    16851685             status=nf90_inq_dimid(ncidv, "LONV", dimid)
    1686              status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim)
     1686             status=nf90_inquire_dimension(ncidv,dimid,namedim,lendim)
    16871687             
    16881688                IF (lendim /= iip1) THEN
    … …  
    16931693
    16941694             status=nf90_inq_dimid(ncidv, "LATV", dimid)
    1695              status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim)
     1695             status=nf90_inquire_dimension(ncidv,dimid,namedim,lendim)
    16961696             IF (lendim /= jjm) THEN
    16971697                abort_message='dimension LATV different from jjm in v.nc'
    … …  
    17171717
    17181718             status=nf90_inq_dimid(ncidt, "LONV", dimid)
    1719              status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
     1719             status=nf90_inquire_dimension(ncidt,dimid,namedim,lendim)
    17201720             IF (lendim /= iip1) THEN
    17211721                abort_message='dimension LONV different from iip1 in T.nc'
    … …  
    17241724
    17251725             status=nf90_inq_dimid(ncidt, "LATU", dimid)
    1726              status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
     1726             status=nf90_inquire_dimension(ncidt,dimid,namedim,lendim)
    17271727             IF (lendim /= jjp1) THEN
    17281728                abort_message='dimension LATU different from jjp1 in T.nc'
    … …  
    17491749
    17501750             status=nf90_inq_dimid(ncidQ, "LONV", dimid)
    1751              status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
     1751             status=nf90_inquire_dimension(ncidQ,dimid,namedim,lendim)
    17521752             IF (lendim /= iip1) THEN
    17531753                abort_message='dimension LONV different from iip1 in hur.nc'
    … …  
    17561756
    17571757             status=nf90_inq_dimid(ncidQ, "LATU", dimid)
    1758              status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
     1758             status=nf90_inquire_dimension(ncidQ,dimid,namedim,lendim)
    17591759             IF (lendim /= jjp1) THEN
    17601760                abort_message='dimension LATU different from jjp1 in hur.nc'

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

    r5088 r5099  
    1 !
     1
    22! $Id: iniacademic.F90 1625 2012-05-09 13:14:48Z lguez $
    3 !
     3
    44SUBROUTINE iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0)
    55
    … …  
    2323  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
    2424  USE readTracFiles_mod, ONLY: addPhase
    25   use netcdf, only : NF90_NOWRITE,NF90_OPEN,NF90_NOERR,NF90_INQ_VARID,NF90_CLOSE, NF90_GET_VAR
     25  use netcdf, only : NF90_NOWRITE,NF90_OPEN,nf90_noerr,NF90_INQ_VARID,NF90_CLOSE, nf90_get_var
    2626
    2727  !   Author:    Frederic Hourdin      original: 15/01/93
    … …  
    100100  ! 1. Initializations for Earth-like case
    101101  ! --------------------------------------
    102   !
     102
    103103  ! initialize planet radius, rotation rate,...
    104104  call conf_planete
    … …  
    153153     relief=0.
    154154     ierr = NF90_OPEN ('relief_in.nc', NF90_NOWRITE,nid_relief)
    155      if (ierr==NF90_NOERR) THEN
     155     if (ierr==nf90_noerr) THEN
    156156         ierr=NF90_INQ_VARID(nid_relief,'RELIEF',varid)
    157          if (ierr==NF90_NOERR) THEN
    158               ierr=NF90_GET_VAR(nid_relief,varid,relief(1:iim,1:jjp1))
     157         if (ierr==nf90_noerr) THEN
     158              ierr=nf90_get_var(nid_relief,varid,relief(1:iim,1:jjp1))
    159159              relief(iip1,:)=relief(1,:)
    160160         else

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initdynav_loc.F

    r5082 r5099  
    1 !
     1
    22! $Id: initdynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
    3 !
     3
    44      subroutine initdynav_loc(day0,anne0,tstep,t_ops,t_wrt)
    55

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initfluxsto_p.F

    r2622 r5099  
    1 !
     1
    22! $Id$
    3 !
     3
    44      subroutine initfluxsto_p
    55     .  (infile,tstep,t_ops,t_wrt,

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/inithist_loc.F

    r4050 r5099  
    1 !
     1
    22! $Id: initdynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
    3 !
     3
    44      subroutine inithist_loc(day0,anne0,tstep,t_ops,t_wrt)
    55

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/integrd_loc.F

    r5086 r5099  
    1 !
     1
    22! $Id: integrd_p.F 1299 2010-01-20 14:27:21Z fairhead $
    3 !
     3
    44      SUBROUTINE integrd_loc
    55     $  (  nq,vcovm1,ucovm1,tetam1,psm1,massem1,
    … …  
    234234!      ijb=ij_begin
    235235!      ije=ij_end
    236 !     
     236
    237237!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    238238!      DO  l = 1,llm

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

    r5091 r5099  
    1 !
     1
    22! $Id$
    3 !
     3
    44c
    55c
    … …  
    256256!$OMP MASTER
    257257      if (firstcall) then
    258 !     
     258
    259259!      ALLOCATE(p(ijb_u:ije_u,llmp1))
    260260!      ALLOCATE(pks(ijb_u:ije_u))
    … …  
    579579!         call Register_SwapFieldHallo(finvmaold,finvmaold,ip1jmp1,llm,
    580580!     &                                jj_Nb_caldyn,0,0,TestRequest)
    581 !
     581
    582582!        do j=1,nqtot
    583583!         call Register_SwapFieldHallo(q(:,:,j),q(:,:,j),ip1jmp1,llm,
    584584!     &                                jj_nb_caldyn,0,0,TestRequest)
    585585!        enddo
    586 !
     586
    587587!         call Set_Distrib(distrib_caldyn)
    588588!         call SendRequest(TestRequest)
    … …  
    864864
    865865! c  Diagnostique de conservation de l'energie : initialisation
    866 ! 
     866
    867867! c-jld
    868868! c$OMP BARRIER
    … …  
    879879! #endif
    880880!         call SetTag(Request_physic,800)
    881 !         
     881
    882882!         call Register_SwapField_u(ucov,ucov,distrib_physic,
    883883!      *                            Request_physic,up=2,down=2)
    884 !         
     884
    885885!         call Register_SwapField_v(vcov,vcov,distrib_physic,
    886886!      *                            Request_physic,up=2,down=2)
    … …  
    888888!         call Register_SwapField_u(teta,teta,distrib_physic,
    889889!      *                            Request_physic,up=2,down=2)
    890 !         
     890
    891891!         call Register_SwapField_u(masse,masse,distrib_physic,
    892892!      *                            Request_physic,up=1,down=2)
    … …  
    894894!         call Register_SwapField_u(p,p,distrib_physic,
    895895!      *                            Request_physic,up=2,down=2)
    896 !         
     896
    897897!         call Register_SwapField_u(pk,pk,distrib_physic,
    898898!      *                            Request_physic,up=2,down=2)
    899 !         
     899
    900900!         call Register_SwapField_u(phis,phis,distrib_physic,
    901901!      *                            Request_physic,up=2,down=2)
    902 !         
     902
    903903!         call Register_SwapField_u(phi,phi,distrib_physic,
    904904!      *                            Request_physic,up=2,down=2)
    905 !         
     905
    906906!         call Register_SwapField_u(w,w,distrib_physic,
    907907!      *                            Request_physic,up=2,down=2)
    908 !         
     908
    909909!         call Register_SwapField_u(q,q,distrib_physic,
    910910!      *                            Request_physic,up=2,down=2)
    … …  
    912912!         call Register_SwapField_u(flxw,flxw,distrib_physic,
    913913!      *                            Request_physic,up=2,down=2)
    914 !         
     914
    915915!         call SendRequest(Request_Physic)
    916916! c$OMP BARRIER
    … …  
    921921!         call Set_Distrib(distrib_Physic)
    922922!         call VTe(VThallo)
    923 !         
     923
    924924!         call VTb(VTphysiq)
    925925! c$OMP END MASTER
    … …  
    10801080!         call Register_SwapField_u(ucov,ucov,
    10811081!      *                               distrib_caldyn,Request_physic)
    1082 !         
     1082
    10831083!         call Register_SwapField_v(vcov,vcov,
    10841084!      *                               distrib_caldyn,Request_physic)
    1085 !         
     1085
    10861086!         call Register_SwapField_u(teta,teta,
    10871087!      *                               distrib_caldyn,Request_physic)
    1088 !         
     1088
    10891089!         call Register_SwapField_u(masse,masse,
    10901090!      *                               distrib_caldyn,Request_physic)
    … …  
    10921092!         call Register_SwapField_u(p,p,
    10931093!      *                               distrib_caldyn,Request_physic)
    1094 !         
     1094
    10951095!         call Register_SwapField_u(pk,pk,
    10961096!      *                               distrib_caldyn,Request_physic)
    1097 !         
     1097
    10981098!         call Register_SwapField_u(phis,phis,
    10991099!      *                               distrib_caldyn,Request_physic)
    1100 !         
     1100
    11011101!         call Register_SwapField_u(phi,phi,
    11021102!      *                               distrib_caldyn,Request_physic)
    1103 !         
     1103
    11041104!         call Register_SwapField_u(w,w,
    11051105!      *                               distrib_caldyn,Request_physic)
    … …  
    11071107!         call Register_SwapField_u(q,q,
    11081108!      *                               distrib_caldyn,Request_physic)
    1109 !         
     1109
    11101110!         call SendRequest(Request_Physic)
    11111111! c$OMP BARRIER
    … …  
    12261226!c$OMP MASTER
    12271227!        call suspend_timer(timer_caldyn)
    1228 !       
     1228
    12291229!c       print*,'Entree dans la dissipation : Iteration No ',true_itau
    12301230!c   calcul de l'energie cinetique avant dissipation
    … …  
    12771277!        call WriteField_u('dtetadis',dtetadis)
    12781278!#endif
    1279 !
     1279
    12801280!!      CALL FTRACE_REGION_END("dissip")
    1281 !         
     1281
    12821282!        ijb=ij_begin
    12831283!        ije=ij_end
    … …  
    13181318!            call covcont_loc(llm,ucov,vcov,ucont,vcont)
    13191319!            call enercin_loc(vcov,ucov,vcont,ucont,ecin)
    1320 !           
     1320
    13211321!            ijb=ij_begin
    13221322!            ije=ij_end
    … …  
    13491349!        ijb=ij_begin
    13501350!        ije=ij_end
    1351 !         
     1351
    13521352!        if (pole_nord) then
    13531353!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    … …  
    13691369!          ENDDO
    13701370!            tpn  = SSUM(iim,tppn,1)/apoln
    1371 ! 
     1371
    13721372!          DO ij = 1, iip1
    13731373!            ps(  ij    ) = tpn
    … …  
    13751375!c$OMP END MASTER
    13761376!        endif
    1377 !       
     1377
    13781378!        if (pole_sud) then
    13791379!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    … …  
    13951395!          ENDDO
    13961396!            tps  = SSUM(iim,tpps,1)/apols
    1397 ! 
     1397
    13981398!          DO ij = 1, iip1
    13991399!            ps(ij+ip1jm) = tps
    … …  
    14081408
    14091409!        call stop_timer(timer_dissip)
    1410 !       
     1410
    14111411!        call VTb(VThallo)
    14121412!c$OMP END MASTER
    … …  
    17381738!             iday = day_ini+itau/day_step
    17391739!             time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
    1740 !
     1740
    17411741!                  IF(time.GT.1.) THEN
    17421742!                   time = time-1.

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

    r5090 r5099  
    129129#endif
    130130
    131 !
    132131!     .......   Ajout   P.Le Van ( 17/04/96 )   ...........
    133 !
    134 
    135132
    136133  !$OMP MASTER
    … …  
    390387  !$OMP BARRIER
    391388
    392 !
    393389!  Diagnostique de conservation de l'energie : difference
    394390    IF (ip_ebil_dyn>=1 ) THEN

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

    r4996 r5099  
    1 !
     1
    22! $Id: $
    3 !
     3
    44MODULE logic_mod
    55

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

    r2336 r5099  
    11SUBROUTINE massbar_loc(masse,massebx,masseby)
    2 !
     2
    33!-------------------------------------------------------------------------------
    44! Authors: P. Le Van , Fr. Hourdin.
    … …  
    2323!    * alpha4(i,j) at point ( i-1/4,j-1/4 )
    2424! where alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)
    25 !
     25
    2626!   alpha4 .         . alpha1    . alpha4
    2727!    (i,j)             (i,j)       (i+1,j)
    28 !
     28
    2929!             P .        U .          . P
    3030!           (i,j)       (i,j)         (i+1,j)
    31 !
     31
    3232!   alpha3 .         . alpha2    .alpha3
    3333!    (i,j)              (i,j)     (i+1,j)
    34 !
     34
    3535!             V .        Z .          . V
    3636!           (i,j)
    37 !
     37
    3838!   alpha4 .         . alpha1    .alpha4
    3939!   (i,j+1)            (i,j+1)   (i+1,j+1)
    40 !
     40
    4141!             P .        U .          . P
    4242!          (i,j+1)                    (i+1,j+1)
    43 !
    44 !
     43
     44
    4545!    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
    4646!                   masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
    4747!     localized at point  ... U (i,j) ...
    48 !
     48
    4949!    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
    5050!                   masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1) 

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

    r5081 r5099  
    11SUBROUTINE massbarxy_loc(masse,massebxy)
    2 !
     2
    33!-------------------------------------------------------------------------------
    44! Authors: P. Le Van , Fr. Hourdin.

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

    r4848 r5099  
    1 !
     1
    22! $Id: mod_const_para.F90 1279 2009-12-10 09:02:56Z fairhead $
    3 !
     3
    44MODULE mod_const_mpi
    55  IMPLICIT NONE

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_filtreg_p.F

    r5091 r5099  
    420420
    421421!      DO j=1,nlat
    422 !     
     422
    423423!          PRINT *,"check FFT ----> Delta(",j,")=",
    424424!     &            sum(champ(:,j,:)-champ_fft(:,j,:))/sum(champ(:,j,:)),
    … …  
    428428!          PRINT *,"check FFT ----> Delta(",j,")=",
    429429!     &            sum(champ-champ_fft)/sum(champ)
    430 !     
    431      
     430
    432431c
    433432 1111 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau  CHAMP a

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

    r4619 r5099  
    1 !
     1
    22! $Id$
    3 !
     3
    44! This module contains the interface between the LMDZ dynamics dyn3dmem module and XIOS.
    5 !
     5
    66! Lists of subroutines
    77!      xios_dyn3dmem_init : context / calendar / domain / axis initialisations
    8 !
     8
    99! Initialisation of communicator between LMDZ and XIOS is done elsewhere: wxios_init called by init_const_mpi
    1010!                                                                         (one of the first calls in gcm.F90)
    1111! L. Fairhead 11/2017
    12 !
    13 !
     12
    1413
    1514MODULE mod_xios_dyn3dmem

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

    r5093 r5099  
    1 !
     1
    22! $Id$
    3 !
     3
    44  MODULE parallel_lmdz
    55  USE mod_const_mpi
    … …  
    742742!      INCLUDE "dimensions.h"
    743743!      INCLUDE "paramet.h"   
    744 !   
     744
    745745!      INTEGER :: ij,ll
    746746!      REAL, dimension(ij,ll) :: Field
    747747!      INTEGER :: up,down
    748 !     
     748
    749749!      REAL,dimension(ij,ll): NewField
    750 !     
     750
    751751!      NewField=0
    752 !     
     752
    753753!      ijb=ij_begin
    754754!      ije=ij_end

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/paramet.h

    r1907 r5099  
    1 !
     1
    22! $Id$
    3 !
    4 !
     3
     4
    55!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
    66!                 veillez  n'utiliser que des ! pour les commentaires
    77!                 et  bien positionner les & des lignes de continuation
    88!                 (les placer en colonne 6 et en colonne 73)
    9 !
    10 !
     9
     10
    1111!-----------------------------------------------------------------------
    1212!   INCLUDE 'paramet.h'

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

    r5082 r5099  
    1 !
     1
    22!     $Id$
    3 !
     3
    44      SUBROUTINE qminimum_loc( q,nqtot,deltap )
    55      USE parallel_lmdz

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/sw_case_williamson91_6_loc.F

    r2600 r5099  
    1 !
     1
    22! $Id $
    3 !
     3
    44      SUBROUTINE sw_case_williamson91_6_loc(vcov,ucov,teta,masse,ps)
    55

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

    r4608 r5099  
    1 !
     1
    22! $Id: temps_mod.F90 -1   $
    3 !
     3
    44MODULE temps_mod
    55

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/top_bound_loc.F

    r5093 r5099  
    1 !
     1
    22! $Id: $
    3 !
     3
    44      SUBROUTINE top_bound_loc(vcov,ucov,teta,masse,dt)
    55      USE parallel_lmdz

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

    r2603 r5099  
    11SUBROUTINE tourpot_loc ( vcov, ucov, massebxy, vorpot )
    2 !
     2
    33!-------------------------------------------------------------------------------
    44! Authors: P. Le Van.

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

    r2600 r5099  
    11SUBROUTINE vitvert_loc(convm, w)
    2 !
     2
    33!-------------------------------------------------------------------------------
    44! Authors: P. Le Van , Fr. Hourdin.

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlsplt_loc.F

    r5098 r5099  
    1 !
     1
    22! $Id$
    3 !
     3
    44      RECURSIVE SUBROUTINE vlx_loc(q,pente_max,masse,u_m,ijb_x,ije_x,iq)
    55

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltgen_loc.F

    r4996 r5099  
    11
    2 !     
    32! $Header$
    4 !
     3
    54       SUBROUTINE vlspltgen_loc( q,pente_max,masse,w,pbaru,pbarv,
    65     &                           pdt, p,pk,teta                 )

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltqs_loc.F

    r5098 r5099  
    1 !
     1
    22!     $Id$
    3 !
     3
    44      SUBROUTINE vlxqs_loc(q,pente_max,masse,u_m,qsat,ijb_x,ije_x,iq)
    55c

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/wrgrads.F

    r5082 r5099  
    1 !
     1
    22! $Header$
    3 !
     3
    44      subroutine wrgrads(if,nl,field,name,titlevar)
    55      implicit none

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

    r5087 r5099  
    11
    22! $Id$
    3 !
     3
    44      SUBROUTINE writedyn_xios( vcov, ucov,teta,ppk,phi,q, &
    55                             masse,ps,phis)
    … …  
    1515     
    1616      implicit none
    17 !
     17
    1818!   Ecriture du fichier histoire au format xios
    19 !
    20 !
     19
     20
    2121!   Entree:
    2222!      vcov: vents v covariants
    … …  
    2828!      ps   :pression au sol
    2929!      phis : geopotentiel au sol
    30 !     
     30
    3131!   L. Fairhead, LMD, 03/21
    32 !
     32
    3333! =====================================================================
    34 !
     34
    3535!   Declarations
    3636      include "dimensions.h"
    … …  
    4040      include "iniprint.h"
    4141
    42 !
    4342!   Arguments
    44 !
    4543
    4644      REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
    … …  
    5452
    5553!   Variables locales
    56 !
     54
    5755      INTEGER,SAVE,ALLOCATABLE :: ndex2d(:),ndexu(:),ndexv(:)
    5856      INTEGER :: iq, ii, ll
    … …  
    6866!$OMP THREADPRIVATE(first)
    6967
    70 !
    7168!  Initialisations
    72 !
    7369
    7470!      WRITE(*,*)'IN WRITEDYN_XIOS'
    … …  
    10399      call covnat_loc(llm, ucov, vcov, unat, vnat)
    104100
    105 !
    106101!  Appels a histwrite pour l'ecriture des variables a sauvegarder
    107 !
     102
    108103!  Vents U
    109 !
     104
    110105      ijb=ij_begin
    111106      ije=ij_end
    … …  
    114109      CALL writefield_dyn_u('U', unat(ijb:ije,:))
    115110
    116 !
    117111!  Vents V
    118 !
     112
    119113      ije=ij_end
    120114      IF (pole_sud) THEN
    … …  
    130124         CALL writefield_dyn_v('V', vbuffer(ijb:ije,:))
    131125      ENDIF
    132      
    133126
    134      
    135 !
    136127!  Temperature potentielle moyennee
    137 !
     128
    138129      ijb=ij_begin
    139130      ije=ij_end
    … …  
    141132     CALL writefield_dyn_u('THETA', teta(ijb:ije,:))
    142133
    143 !
    144134!  Temperature moyennee
    145 !
    146135
    147136!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    … …  
    154143      CALL writefield_dyn_u('TEMP', tm(ijb:ije,:))
    155144
     145!  Geopotentiel
    156146
    157 !
    158 !  Geopotentiel
    159 !
    160147      CALL writefield_dyn_u('PHI', phi(ijb:ije,:))
    161148
     149! Tracers?
    162150
    163 !
    164 ! Tracers?
    165 !
    166151!        DO iq=1,nqtot
    167152!        ENDDO
    168153
     154!  Masse
    169155
    170 !
    171 !  Masse
    172 !
    173156      CALL writefield_dyn_u('MASSE', masse(ijb:ije,:))
    174157
     158!  Pression au sol
    175159
    176 !
    177 !  Pression au sol
    178 !
    179160      CALL writefield_dyn_u('PS', ps(ijb:ije))
    180161

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.F

    r4046 r5099  
    1 !
     1
    22! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
    3 !
     3
    44      subroutine writedynav_loc( time, vcov, ucov,teta,ppk,phi,q,
    55     .                           masse,ps,phis)

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writehist_loc.F

    r4046 r5099  
    1 !
     1
    22! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
    3 !
     3
    44      subroutine writehist_loc( time, vcov, ucov,teta,ppk,phi,q,
    55     .                          masse,ps,phis)
Note: See TracChangeset for help on using the changeset viewer.