Changeset 841 for trunk/LMDZ.COMMON/libf


Ignore:
Timestamp:
Nov 13, 2012, 9:21:32 AM (12 years ago)
Author:
emillour
Message:

Common dynamics:

  • updates to keep up with LMDZ5 Earth (rev 1678) changes
  • fixed bug in leapfrog_p.F: parallel dynamics now work fine.
  • see file "DOC/chantiers/commit_importants.log" for details.

EM

Location:
trunk/LMDZ.COMMON/libf
Files:
21 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.COMMON/libf/dyn3d/calfis.F

    r776 r841  
    184184!      REAL rdayvrai
    185185      REAL, intent(in):: jD_cur, jH_cur
     186
     187      LOGICAL tracerdyn ! for generic/mars physics call ; possibly to get rid of
    186188c
    187189c-----------------------------------------------------------------------
    … …  
    460462c
    461463      if (planet_type=="earth") then
    462 #ifdef CPP_EARTH
     464#ifdef CPP_PHYS
    463465! PVtheta calls tetalevel, which is in the (Earth) physics
    464466cIM calcul PV a teta=350, 380, 405K
    … …  
    525527     .             PVteta)
    526528
     529      else if ( planet_type=="generic" ) then
     530
     531         CALL physiq (ngridmx,     !! ngrid
     532     .             llm,            !! nlayer
     533     .             nqtot,          !! nq
     534     .             tname,          !! tracer names from dynamical core (given in infotrac)
     535     .             debut_split,    !! firstcall
     536     .             lafin_split,    !! lastcall
     537     .             jD_cur,         !! pday. see leapfrog
     538     .             jH_cur_split,   !! ptime "fraction of day"
     539     .             zdt_split,      !! ptimestep
     540     .             zplev,          !! pplev
     541     .             zplay,          !! pplay
     542     .             zphi,           !! pphi
     543     .             zufi,           !! pu
     544     .             zvfi,           !! pv
     545     .             ztfi,           !! pt
     546     .             zqfi,           !! pq
     547     .             flxwfi,         !! pw !! or 0. anyway this is for diagnostic. not used in physiq.
     548     .             zdufi,          !! pdu
     549     .             zdvfi,          !! pdv
     550     .             zdtfi,          !! pdt
     551     .             zdqfi,          !! pdq
     552     .             zdpsrf,         !! pdpsrf
     553     .             tracerdyn)      !! tracerdyn <-- utilite ???
     554
    527555      else  ! a moduler pour Mars !!
    528556

  • trunk/LMDZ.COMMON/libf/dyn3d/comconst.h

    r108 r841  
    2121      REAL dtdiss ! (s) time step for the dissipation
    2222      REAL rad ! (m) radius of the planet
    23       REAL r ! Gas constant R=8.31 J.K-1.mol-1
     23      REAL r ! Reduced Gas constant r=R/mu
     24             ! with R=8.31.. J.K-1.mol-1, mu: mol mass of atmosphere (kg/mol)
    2425      REAL cpp   ! Cp
    2526      REAL kappa ! kappa=R/Cp

  • trunk/LMDZ.COMMON/libf/dyn3d/comvert.h

    r776 r841  
    11!
    2 ! $Id: comvert.h 1625 2012-05-09 13:14:48Z lguez $
     2! $Id: comvert.h 1654 2012-09-24 15:07:18Z aslmd $
    33!
    44!-----------------------------------------------------------------------
    … …  
    77      COMMON/comvertr/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm),     &
    88     &               pa,preff,nivsigs(llm),nivsig(llm+1),               &
    9      &               aps(llm),bps(llm),scaleheight
     9     &               aps(llm),bps(llm),scaleheight,pseudoalt(llm)
    1010
    1111      common/comverti/disvert_type, pressure_exner
    … …  
    2323      real bps    ! hybrid sigma contribution at mid-layers
    2424      real scaleheight ! atmospheric (reference) scale height (km)
     25      real pseudoalt ! for planets
    2526
    2627      integer disvert_type ! type of vertical discretization:

  • trunk/LMDZ.COMMON/libf/dyn3d/disvert_noterre.F

    r127 r841  
    4646      real tt,rr,gg, prevz
    4747      real s(llm),dsig(llm)
    48       real pseudoalt(llm)
    4948
    5049      integer iz

  • trunk/LMDZ.COMMON/libf/dyn3d/dynetat0.F

    r776 r841  
    77      USE infotrac
    88      use netcdf, only: nf90_get_var
     9
     10      use control_mod, only : planet_type
     11
    912      IMPLICIT NONE
    1013
    … …  
    5457      INTEGER ierr, nid, nvarid
    5558
     59      INTEGER idecal
     60
    5661c-----------------------------------------------------------------------
    5762
    … …  
    7782      ENDIF
    7883
     84      !!! AS: idecal is a hack to be able to read planeto starts...
     85      !!!     .... while keeping everything OK for LMDZ EARTH
     86      if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
     87          write(lunout,*)'dynetat0 : Planeto-like start file'
     88          idecal = 4
     89          annee_ref  = 2000
     90      else
     91          write(lunout,*)'dynetat0 : Earth-like start file'
     92          idecal = 5
     93          annee_ref  = tab_cntrl(5)
     94      endif
     95
     96
    7997      im         = tab_cntrl(1)
    8098      jm         = tab_cntrl(2)
    8199      lllm       = tab_cntrl(3)
    82100      day_ref    = tab_cntrl(4)
    83       annee_ref  = tab_cntrl(5)
    84       rad        = tab_cntrl(6)
    85       omeg       = tab_cntrl(7)
    86       g          = tab_cntrl(8)
    87       cpp        = tab_cntrl(9)
    88       kappa      = tab_cntrl(10)
    89       daysec     = tab_cntrl(11)
    90       dtvr       = tab_cntrl(12)
    91       etot0      = tab_cntrl(13)
    92       ptot0      = tab_cntrl(14)
    93       ztot0      = tab_cntrl(15)
    94       stot0      = tab_cntrl(16)
    95       ang0       = tab_cntrl(17)
    96       pa         = tab_cntrl(18)
    97       preff      = tab_cntrl(19)
    98 c
    99       clon       = tab_cntrl(20)
    100       clat       = tab_cntrl(21)
    101       grossismx  = tab_cntrl(22)
    102       grossismy  = tab_cntrl(23)
    103 c
    104       IF ( tab_cntrl(24).EQ.1. )  THEN
     101      rad        = tab_cntrl(idecal+1)
     102      omeg       = tab_cntrl(idecal+2)
     103      g          = tab_cntrl(idecal+3)
     104      cpp        = tab_cntrl(idecal+4)
     105      kappa      = tab_cntrl(idecal+5)
     106      daysec     = tab_cntrl(idecal+6)
     107      dtvr       = tab_cntrl(idecal+7)
     108      etot0      = tab_cntrl(idecal+8)
     109      ptot0      = tab_cntrl(idecal+9)
     110      ztot0      = tab_cntrl(idecal+10)
     111      stot0      = tab_cntrl(idecal+11)
     112      ang0       = tab_cntrl(idecal+12)
     113      pa         = tab_cntrl(idecal+13)
     114      preff      = tab_cntrl(idecal+14)
     115c
     116      clon       = tab_cntrl(idecal+15)
     117      clat       = tab_cntrl(idecal+16)
     118      grossismx  = tab_cntrl(idecal+17)
     119      grossismy  = tab_cntrl(idecal+18)
     120c
     121      IF ( tab_cntrl(idecal+19).EQ.1. )  THEN
    105122        fxyhypb  = . TRUE .
    106123c        dzoomx   = tab_cntrl(25)
    … …  
    111128        fxyhypb = . FALSE .
    112129        ysinus  = . FALSE .
    113         IF( tab_cntrl(27).EQ.1. ) ysinus = . TRUE.
     130        IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE.
    114131      ENDIF
    115132
    … …  
    225242      IF (ierr .NE. NF_NOERR) THEN
    226243         write(lunout,*)"dynetat0: Le champ <temps> est absent"
    227          CALL abort
     244         write(lunout,*)"dynetat0: J essaie <Time>"
     245         ierr = NF_INQ_VARID (nid, "Time", nvarid)
     246         IF (ierr .NE. NF_NOERR) THEN
     247            write(lunout,*)"dynetat0: Le champ <Time> est absent"
     248            CALL abort
     249         ENDIF
    228250      ENDIF
    229251      ierr = nf90_get_var(nid, nvarid, time)

  • trunk/LMDZ.COMMON/libf/dyn3d/fxhyp.F

    r1 r841  
    11!
    2 ! $Id: fxhyp.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: fxhyp.F 1674 2012-10-29 16:27:03Z emillour $
    33!
    44c
    … …  
    6868       xzoom    = xzoomdeg * pi/180.
    6969c
     70       if (iim==1) then
     71
     72          rlonm025(1)=-pi/2.
     73          rlonv(1)=0.
     74          rlonu(1)=pi
     75          rlonp025(1)=pi/2.
     76          rlonm025(2)=rlonm025(1)+depi
     77          rlonv(2)=rlonv(1)+depi
     78          rlonu(2)=rlonu(1)+depi
     79          rlonp025(2)=rlonp025(1)+depi
     80
     81          xprimm025(:)=1.
     82          xprimv(:)=1.
     83          xprimu(:)=1.
     84          xprimp025(:)=1.
     85          champmin=depi
     86          champmax=depi
     87          return
     88
     89       endif
     90
    7091           decalx   = .75
    7192       IF( grossism.EQ.1..AND.scal180 )  THEN
    … …  
    286307
    287308
     309
    288310       IF(ik.EQ.1.and.grossism.EQ.1.)  THEN
    289311         xvrai(1)    = xvrai(iip1)-depi
    290312         xxprim(1)   = xxprim(iip1)
    291313       ENDIF
     314
    292315       DO i = 1 , iim
    293316        xlon(i)     = xvrai(i)

  • trunk/LMDZ.COMMON/libf/dyn3d/gcm.F

    r815 r841  
    457457! Il faut une cle CPP_PHYS
    458458#ifdef CPP_PHYS
    459          CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys ,
    460      ,                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp     )
     459         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys,
     460     &                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp,
     461     &                iflag_phys)
    461462#endif
    462463         call_iniphys=.false.
    … …  
    490491#endif
    491492
    492 #ifdef CPP_EARTH
    493 ! Create start file (startphy.nc) and boundary conditions (limit.nc)
    494 ! for the Earth verstion
    495        if (iflag_phys>=100) then
    496           call iniaqua(ngridmx,latfi,lonfi,iflag_phys)
    497        endif
    498 #endif
    499 
    500493      if (planet_type.eq."mars") then
    501494! POUR MARS, METTRE UNE FONCTION A PART, genre dynredem0_mars

  • trunk/LMDZ.COMMON/libf/dyn3d/groupe.F

    r1 r841  
    3838      integer i,j,l
    3939
    40       logical firstcall
    41       save firstcall
     40      logical firstcall,groupe_ok
     41      save firstcall,groupe_ok
    4242
    4343      data firstcall/.true./
     44      data groupe_ok/.true./
     45
     46      if (iim==1) then
     47         groupe_ok=.false.
     48      endif
    4449
    4550      if (firstcall) then
    46          if(mod(iim,2**ngroup).ne.0) stop'probleme du nombre ede point'
     51         if (groupe_ok) then
     52           if(mod(iim,2**ngroup).ne.0) stop'probleme du nombre de point'
     53         endif
    4754         firstcall=.false.
    4855      endif
     56
    4957
    5058c   Champs 1D
    … …  
    5260      call convflu(pbaru,pbarv,llm,zconvm)
    5361
    54 c
    5562      call scopy(ijp1llm,zconvm,1,zconvmm,1)
    5663      call scopy(ijmllm,pbarv,1,pbarvm,1)
    5764
    58 c
     65      if (groupe_ok) then
    5966      call groupeun(jjp1,llm,zconvmm)
    6067      call groupeun(jjm,llm,pbarvm)
    6168
    6269c   Champs 3D
    63 
    6470      do l=1,llm
    6571         do j=2,jjm
    … …  
    7480         enddo
    7581      enddo
     82
     83      else
     84         pbarum(:,:,:)=pbaru(:,:,:)
     85         pbarvm(:,:,:)=pbarv(:,:,:)
     86      endif
    7687
    7788c    integration de la convergence de masse de haut  en bas ......

  • trunk/LMDZ.COMMON/libf/dyn3d/leapfrog.F

    r776 r841  
    443443           jD_cur = jD_ref + day_ini - day_ref +                        &
    444444     &          itau/day_step
     445
     446           IF (planet_type .eq."generic") THEN
     447              ! AS: we make jD_cur to be pday
     448              jD_cur = int(day_ini + itau/day_step)
     449           ENDIF
     450
    445451           jH_cur = jH_ref + start_time +                               &
    446452     &          mod(itau,day_step)/float(day_step)
    … …  
    471477c-jld
    472478#ifdef CPP_IOIPSL
    473 cIM : pour sortir les param. du modele dans un fis. netcdf 110106
    474          IF (first) THEN
    475 #include "ini_paramLMDZ_dyn.h"
    476           first=.false.
    477          ENDIF
    478 c
    479 #include "write_paramLMDZ_dyn.h"
     479cIM decommenter les 6 lignes suivantes pour sortir quelques parametres dynamiques de LMDZ
     480cIM uncomment next 6 lines to get some parameters for LMDZ dynamics
     481c        IF (first) THEN
     482c         first=.false.
     483c#include "ini_paramLMDZ_dyn.h"
     484c        ENDIF
     485c
     486c#include "write_paramLMDZ_dyn.h"
    480487c
    481488#endif

  • trunk/LMDZ.COMMON/libf/dyn3d/paramet.h

    r1 r841  
    1717      INTEGER jcfil,jcfllm
    1818
    19       PARAMETER( iip1= iim+1-1/iim,iip2=iim+2,iip3=iim+3                &
     19      PARAMETER( iip1= iim+1,iip2=iim+2,iip3=iim+3                       &
    2020     &    ,jjp1=jjm+1-1/jjm)
    2121      PARAMETER( llmp1 = llm+1,  llmp2 = llm+2, llmm1 = llm-1 )

  • trunk/LMDZ.COMMON/libf/dyn3dpar/calfis_p.F

    r776 r841  
    244244      integer :: k,kstart,kend
    245245      INTEGER :: offset 
     246
     247      LOGICAL tracerdyn ! for generic/mars physics call ; possibly to get rid of
    246248c
    247249c-----------------------------------------------------------------------
    … …  
    701703     .             pducov,
    702704     .             PVteta)
     705
     706      else if ( planet_type=="generic" ) then
     707
     708      CALL physiq (klon,     !! ngrid
     709     .             llm,            !! nlayer
     710     .             nqtot,          !! nq
     711     .             tname,          !! tracer names from dynamical core (given in infotrac)
     712     .             debut_split,    !! firstcall
     713     .             lafin_split,    !! lastcall
     714     .             jD_cur,         !! pday. see leapfrog_p
     715     .             jH_cur_split,   !! ptime "fraction of day"
     716     .             zdt_split,      !! ptimestep
     717     .             zplev_omp,  !! pplev
     718     .             zplay_omp,  !! pplay
     719     .             zphi_omp,   !! pphi
     720     .             zufi_omp,   !! pu
     721     .             zvfi_omp,   !! pv
     722     .             ztfi_omp,   !! pt
     723     .             zqfi_omp,   !! pq
     724     .             flxwfi_omp, !! pw !! or 0. anyway this is for diagnostic. not used in physiq.
     725     .             zdufi_omp,  !! pdu
     726     .             zdvfi_omp,  !! pdv
     727     .             zdtfi_omp,  !! pdt
     728     .             zdqfi_omp,  !! pdq
     729     .             zdpsrf_omp, !! pdpsrf
     730     .             tracerdyn)      !! tracerdyn <-- utilite ???
     731
    703732      else ! a moduler pour Mars
    704733        CALL physiq (klon,

  • trunk/LMDZ.COMMON/libf/dyn3dpar/comconst.h

    r108 r841  
    2121      REAL dtdiss ! (s) time step for the dissipation
    2222      REAL rad ! (m) radius of the planet
    23       REAL r ! Gas constant R=8.31 J.K-1.mol-1
     23      REAL r ! Reduced Gas constant r=R/mu
     24             ! with R=8.31.. J.K-1.mol-1, mu: mol mass of atmosphere (kg/mol)
    2425      REAL cpp   ! Cp
    2526      REAL kappa ! kappa=R/Cp

  • trunk/LMDZ.COMMON/libf/dyn3dpar/comvert.h

    r776 r841  
    11!
    2 ! $Id: comvert.h 1625 2012-05-09 13:14:48Z lguez $
     2! $Id: comvert.h 1654 2012-09-24 15:07:18Z aslmd $
    33!
    44!-----------------------------------------------------------------------
    … …  
    77      COMMON/comvertr/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm),     &
    88     &               pa,preff,nivsigs(llm),nivsig(llm+1),               &
    9      &               aps(llm),bps(llm),scaleheight
     9     &               aps(llm),bps(llm),scaleheight,pseudoalt(llm)
    1010
    1111      common/comverti/disvert_type, pressure_exner
    … …  
    2323      real bps    ! hybrid sigma contribution at mid-layers
    2424      real scaleheight ! atmospheric (reference) scale height (km)
     25      real pseudoalt ! for planets
    2526
    2627      integer disvert_type ! type of vertical discretization:

  • trunk/LMDZ.COMMON/libf/dyn3dpar/disvert_noterre.F

    r124 r841  
     1! $Id: $
    12      SUBROUTINE disvert_noterre
    23
    … …  
    2223c
    2324c=======================================================================
    24 c    Discretisation verticale en coordonnée hybride
     25c    Discretisation verticale en coordonnée hybride (ou sigma)
    2526c
    2627c=======================================================================
    … …  
    4546      real tt,rr,gg, prevz
    4647      real s(llm),dsig(llm)
    47       real pseudoalt(llm)
    4848
    4949      integer iz
    5050      real z, ps,p
     51      character(len=*),parameter :: modname="disvert_noterre"
    5152
    5253c
    … …  
    5455c
    5556! Initializations:
    56       pi=2.*ASIN(1.)
     57!      pi=2.*ASIN(1.) ! already done in iniconst
    5758     
    5859      hybrid=.true. ! default value for hybrid (ie: use hybrid coordinates)
    5960      CALL getin('hybrid',hybrid)
    60       write(lunout,*)'disvert_noterre: hybrid=',hybrid
     61      write(lunout,*) trim(modname),': hybrid=',hybrid
    6162
    6263! Ouverture possible de fichiers typiquement E.T.
    … …  
    156157
    157158      DO l=1,llm
    158         nivsigs(l) = FLOAT(l)
     159        nivsigs(l) = REAL(l)
    159160      ENDDO
    160161
    161162      DO l=1,llmp1
    162         nivsig(l)= FLOAT(l)
     163        nivsig(l)= REAL(l)
    163164      ENDDO
    164165
    … …  
    199200      bp(llmp1) =   0.
    200201
    201       write(lunout,*)' BP '
     202      write(lunout,*) trim(modname),': BP '
    202203      write(lunout,*)  bp
    203       write(lunout,*)' AP '
     204      write(lunout,*) trim(modname),': AP '
    204205      write(lunout,*)  ap
    205206
    … …  
    225226      end if
    226227
    227       write(lunout,*)' BPs '
     228      write(lunout,*) trim(modname),': BPs '
    228229      write(lunout,*)  bps
    229       write(lunout,*)' APs'
     230      write(lunout,*) trim(modname),': APs'
    230231      write(lunout,*)  aps
    231232
    … …  
    235236      ENDDO
    236237
    237       write(lunout,*)' PRESNIVS'
     238      write(lunout,*)trim(modname),' : PRESNIVS'
    238239      write(lunout,*)presnivs
    239240      write(lunout,*)'Pseudo altitude of Presnivs : (for a scale ',

  • trunk/LMDZ.COMMON/libf/dyn3dpar/dynetat0.F

    r776 r841  
    77      USE infotrac
    88      use netcdf, only: nf90_get_var
     9
     10      use control_mod, only : planet_type
     11
    912      IMPLICIT NONE
    1013
    … …  
    5457      INTEGER ierr, nid, nvarid
    5558
     59      INTEGER idecal
     60
    5661c-----------------------------------------------------------------------
    5762
    … …  
    7782      ENDIF
    7883
     84      !!! AS: idecal is a hack to be able to read planeto starts...
     85      !!!     .... while keeping everything OK for LMDZ EARTH
     86      if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
     87          write(lunout,*)'dynetat0 : Planeto-like start file'
     88          idecal = 4
     89          annee_ref  = 2000
     90      else
     91          write(lunout,*)'dynetat0 : Earth-like start file'
     92          idecal = 5
     93          annee_ref  = tab_cntrl(5)
     94      endif
     95
     96
    7997      im         = tab_cntrl(1)
    8098      jm         = tab_cntrl(2)
    8199      lllm       = tab_cntrl(3)
    82100      day_ref    = tab_cntrl(4)
    83       annee_ref  = tab_cntrl(5)
    84       rad        = tab_cntrl(6)
    85       omeg       = tab_cntrl(7)
    86       g          = tab_cntrl(8)
    87       cpp        = tab_cntrl(9)
    88       kappa      = tab_cntrl(10)
    89       daysec     = tab_cntrl(11)
    90       dtvr       = tab_cntrl(12)
    91       etot0      = tab_cntrl(13)
    92       ptot0      = tab_cntrl(14)
    93       ztot0      = tab_cntrl(15)
    94       stot0      = tab_cntrl(16)
    95       ang0       = tab_cntrl(17)
    96       pa         = tab_cntrl(18)
    97       preff      = tab_cntrl(19)
    98 c
    99       clon       = tab_cntrl(20)
    100       clat       = tab_cntrl(21)
    101       grossismx  = tab_cntrl(22)
    102       grossismy  = tab_cntrl(23)
    103 c
    104       IF ( tab_cntrl(24).EQ.1. )  THEN
     101      rad        = tab_cntrl(idecal+1)
     102      omeg       = tab_cntrl(idecal+2)
     103      g          = tab_cntrl(idecal+3)
     104      cpp        = tab_cntrl(idecal+4)
     105      kappa      = tab_cntrl(idecal+5)
     106      daysec     = tab_cntrl(idecal+6)
     107      dtvr       = tab_cntrl(idecal+7)
     108      etot0      = tab_cntrl(idecal+8)
     109      ptot0      = tab_cntrl(idecal+9)
     110      ztot0      = tab_cntrl(idecal+10)
     111      stot0      = tab_cntrl(idecal+11)
     112      ang0       = tab_cntrl(idecal+12)
     113      pa         = tab_cntrl(idecal+13)
     114      preff      = tab_cntrl(idecal+14)
     115c
     116      clon       = tab_cntrl(idecal+15)
     117      clat       = tab_cntrl(idecal+16)
     118      grossismx  = tab_cntrl(idecal+17)
     119      grossismy  = tab_cntrl(idecal+18)
     120c
     121      IF ( tab_cntrl(idecal+19).EQ.1. )  THEN
    105122        fxyhypb  = . TRUE .
    106123c        dzoomx   = tab_cntrl(25)
    … …  
    111128        fxyhypb = . FALSE .
    112129        ysinus  = . FALSE .
    113         IF( tab_cntrl(27).EQ.1. ) ysinus = . TRUE.
     130        IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE.
    114131      ENDIF
    115132
    … …  
    225242      IF (ierr .NE. NF_NOERR) THEN
    226243         write(lunout,*)"dynetat0: Le champ <temps> est absent"
    227          CALL abort
     244         write(lunout,*)"dynetat0: J essaie <Time>"
     245         ierr = NF_INQ_VARID (nid, "Time", nvarid)
     246         IF (ierr .NE. NF_NOERR) THEN
     247            write(lunout,*)"dynetat0: Le champ <Time> est absent"
     248            CALL abort
     249         ENDIF
    228250      ENDIF
    229251      ierr = nf90_get_var(nid, nvarid, time)

  • trunk/LMDZ.COMMON/libf/dyn3dpar/fxhyp.F

    r1 r841  
    11!
    2 ! $Id: fxhyp.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: fxhyp.F 1674 2012-10-29 16:27:03Z emillour $
    33!
    44c
    … …  
    4848c
    4949       REAL   dzoom
    50        REAL*8 xlon(iip1),xprimm(iip1),xuv
    51        REAL*8 xtild(0:nmax2)
    52        REAL*8 fhyp(0:nmax2),ffdx,beta,Xprimt(0:nmax2)
    53        REAL*8 Xf(0:nmax2),xxpr(0:nmax2)
    54        REAL*8 xvrai(iip1),xxprim(iip1)
    55        REAL*8 pi,depi,epsilon,xzoom,fa,fb
    56        REAL*8 Xf1, Xfi , a0,a1,a2,a3,xi2
     50       REAL(KIND=8) xlon(iip1),xprimm(iip1),xuv
     51       REAL(KIND=8) xtild(0:nmax2)
     52       REAL(KIND=8) fhyp(0:nmax2),ffdx,beta,Xprimt(0:nmax2)
     53       REAL(KIND=8) Xf(0:nmax2),xxpr(0:nmax2)
     54       REAL(KIND=8) xvrai(iip1),xxprim(iip1)
     55       REAL(KIND=8) pi,depi,epsilon,xzoom,fa,fb
     56       REAL(KIND=8) Xf1, Xfi , a0,a1,a2,a3,xi2
    5757       INTEGER i,it,ik,iter,ii,idif,ii1,ii2
    58        REAL*8 xi,xo1,xmoy,xlon2,fxm,Xprimin
    59        REAL*8 champmin,champmax,decalx
     58       REAL(KIND=8) xi,xo1,xmoy,xlon2,fxm,Xprimin
     59       REAL(KIND=8) champmin,champmax,decalx
    6060       INTEGER is2
    6161       SAVE is2
    6262
    63        REAL*8 heavyside
     63       REAL(KIND=8) heavyside
    6464
    6565       pi       = 2. * ASIN(1.)
    … …  
    6868       xzoom    = xzoomdeg * pi/180.
    6969c
     70       if (iim==1) then
     71
     72          rlonm025(1)=-pi/2.
     73          rlonv(1)=0.
     74          rlonu(1)=pi
     75          rlonp025(1)=pi/2.
     76          rlonm025(2)=rlonm025(1)+depi
     77          rlonv(2)=rlonv(1)+depi
     78          rlonu(2)=rlonu(1)+depi
     79          rlonp025(2)=rlonp025(1)+depi
     80
     81          xprimm025(:)=1.
     82          xprimv(:)=1.
     83          xprimu(:)=1.
     84          xprimp025(:)=1.
     85          champmin=depi
     86          champmax=depi
     87          return
     88
     89       endif
     90
    7091           decalx   = .75
    7192       IF( grossism.EQ.1..AND.scal180 )  THEN
    … …  
    286307
    287308
     309
    288310       IF(ik.EQ.1.and.grossism.EQ.1.)  THEN
    289311         xvrai(1)    = xvrai(iip1)-depi
    290312         xxprim(1)   = xxprim(iip1)
    291313       ENDIF
     314
    292315       DO i = 1 , iim
    293316        xlon(i)     = xvrai(i)

  • trunk/LMDZ.COMMON/libf/dyn3dpar/gcm.F

    r815 r841  
    449449c   -------------------------------
    450450
    451       IF (call_iniphys.and.(iflag_phys.eq.1)) THEN
     451      IF (call_iniphys.and.(iflag_phys==1.or.iflag_phys>=100)) THEN
    452452         latfi(1)=rlatu(1)
    453453         lonfi(1)=0.
    … …  
    469469! Physics
    470470#ifdef CPP_PHYS
    471          CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys ,
    472      ,                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp     )
    473 #endif ! CPP_PHYS
     471         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys,
     472     &                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp,
     473     &                iflag_phys)
     474#endif
    474475         call_iniphys=.false.
    475       ENDIF ! of IF (call_iniphys.and.(iflag_phys.eq.1))
     476      ENDIF ! of IF (call_iniphys.and.(iflag_phys==1.or.iflag_phys>=100))
    476477
    477478
    … …  
    513514#endif
    514515
    515 #ifdef CPP_PHYS
    516 ! Create start file (startphy.nc) and boundary conditions (limit.nc)
    517 ! for the Earth verstion
    518        if (iflag_phys>=100) then
    519           call iniaqua(ngridmx,latfi,lonfi,iflag_phys)
    520        endif
    521 #endif
    522 
    523516      if (planet_type.eq."mars") then
    524517! POUR MARS, METTRE UNE FONCTION A PART, genre dynredem0_mars

  • trunk/LMDZ.COMMON/libf/dyn3dpar/groupe_p.F

    r1 r841  
    3737      integer i,j,l
    3838
    39       logical firstcall
    40       save firstcall
    41 c$OMP THREADPRIVATE(firstcall)
     39      logical firstcall,groupe_ok
     40      save firstcall,groupe_ok
     41c$OMP THREADPRIVATE(firstcall,groupe_ok)
    4242
    4343      data firstcall/.true./
     44      data groupe_ok/.true./
     45
    4446      integer ijb,ije,jjb,jje
    4547     
     48      if (iim==1) then
     49         groupe_ok=.false.
     50      endif
     51
    4652      if (firstcall) then
    47          if(mod(iim,2**ngroup).ne.0) stop'probleme du nombre ede point'
     53         if (groupe_ok) then
     54           if(mod(iim,2**ngroup).ne.0) stop'probleme du nombre de point'
     55         endif
    4856         firstcall=.false.
    4957      endif
    … …  
    6674c$OMP END DO NOWAIT
    6775
    68       call groupeun_p(jjp1,llm,jjb,jje,zconvmm)
     76      if (groupe_ok) then
     77         call groupeun_p(jjp1,llm,jjb,jje,zconvmm)
     78      endif
    6979     
    7080      jjb=jj_begin-1
    … …  
    7888c$OMP END DO NOWAIT
    7989
    80       call groupeun_p(jjm,llm,jjb,jje,pbarvm)
     90      if (groupe_ok) then
     91         call groupeun_p(jjm,llm,jjb,jje,pbarvm)
     92      endif
    8193
    8294c   Champs 3D
    … …  
    101113      enddo
    102114c$OMP END DO NOWAIT
     115
    103116c    integration de la convergence de masse de haut  en bas ......
    104117   

  • trunk/LMDZ.COMMON/libf/dyn3dpar/leapfrog_p.F

    r776 r841  
    147147      REAL :: secondes
    148148      real :: rdaym_ini
    149 
     149      logical :: physic
    150150      LOGICAL first,callinigrads
    151151
    … …  
    231231
    232232      itau = 0
     233      physic=.true.
     234      if (iflag_phys==0.or.iflag_phys==2) physic=.false.
    233235!      iday = day_ini+itau/day_step
    234236!      time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
    … …  
    404406     s        apdiss = .TRUE.
    405407         IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward
    406      s          .and. iflag_phys.EQ.1                 ) apphys = .TRUE.
     408     s          .and. physic                        ) apphys = .TRUE.
    407409      ELSE
    408410      ! Leapfrog/Matsuno time stepping
    … …  
    410412         IF( MOD(itau+1,dissip_period).EQ.0 .AND. .NOT. forward )
    411413     s        apdiss = .TRUE.
    412          IF( MOD(itau+1,iphysiq).EQ.0.AND.iflag_phys.EQ.1) apphys=.TRUE.
     414         IF( MOD(itau+1,iphysiq).EQ.0.AND.physic) apphys=.TRUE.
    413415      END IF
    414416
    … …  
    539541      endif
    540542c$OMP END MASTER 
    541       endif      
     543      endif ! of if (Adjust)
    542544     
    543545     
    … …  
    546548c   calcul des tendances dynamiques:
    547549c   --------------------------------
     550! ADAPTATION GCM POUR CP(T)
     551      call tpot2t_p(ip1jmp1,llm,teta,temp,pk)
     552      ijb=ij_begin
     553      ije=ij_end
     554!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     555      do l=1,llm
     556        tsurpk(ijb:ije,l)=cpp*temp(ijb:ije,l)/pk(ijb:ije,l)
     557      enddo
     558!$OMP END DO
     559
     560      if (debug) then
     561!$OMP BARRIER
     562!$OMP MASTER
     563        call WriteField_p('temp',reshape(temp,(/iip1,jmp1,llm/)))
     564        call WriteField_p('tsurpk',reshape(tsurpk,(/iip1,jmp1,llm/)))
     565!$OMP END MASTER       
     566!$OMP BARRIER     
     567      endif ! of if (debug)
     568     
    548569c$OMP BARRIER
    549570c$OMP MASTER
    … …  
    600621      True_itau=True_itau+1
    601622
    602 ! ADAPTATION GCM POUR CP(T)
    603       call tpot2t_p(ip1jmp1,llm,teta,temp,pk)
    604       ijb=ij_begin
    605       ije=ij_end
    606 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    607       do l=1,llm
    608         tsurpk(ijb:ije,l)=cpp*temp(ijb:ije,l)/pk(ijb:ije,l)
    609       enddo
    610 !$OMP END DO
    611 
    612623c$OMP MASTER
    613624      IF (prt_level>9) THEN
    … …  
    784795           jD_cur = jD_ref + day_ini - day_ref
    785796     $        + itau/day_step
     797
     798           IF (planet_type .eq."generic") THEN
     799              ! AS: we make jD_cur to be pday
     800              jD_cur = int(day_ini + itau/day_step)
     801           ENDIF
     802
    786803           jH_cur = jH_ref + start_time +                                &
    787804     &              mod(itau,day_step)/float(day_step)

  • trunk/LMDZ.COMMON/libf/dyn3dpar/parallel.F90

    r492 r841  
    489489          enddo
    490490         
    491         endif
     491        else
     492          ! Ehouarn: When in debug mode, ifort complains (for call MPI_GATHERV
     493          !          below) about Buffer_Recv() being not allocated.
     494          !          So make a dummy allocation.
     495          allocate(Buffer_Recv(1))
     496        endif ! of if (MPI_Rank==rank)
    492497 
    493498!$OMP CRITICAL (MPI)

  • trunk/LMDZ.COMMON/libf/dyn3dpar/paramet.h

    r1 r841  
    1717      INTEGER jcfil,jcfllm
    1818
    19       PARAMETER( iip1= iim+1-1/iim,iip2=iim+2,iip3=iim+3                &
     19      PARAMETER( iip1= iim+1,iip2=iim+2,iip3=iim+3                       &
    2020     &    ,jjp1=jjm+1-1/jjm)
    2121      PARAMETER( llmp1 = llm+1,  llmp2 = llm+2, llmm1 = llm-1 )
Note: See TracChangeset for help on using the changeset viewer.