Ignore:
Timestamp:
Jun 11, 2014, 3:46:46 PM (11 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r1997:2055 into testing branch

Location:
LMDZ5/branches/testing
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/dyn3d/calfis.F

    r1999 r2056  
    163163      REAL unskap, pksurcp
    164164c
    165 cIM diagnostique PVteta, Amip2
    166       INTEGER,PARAMETER :: ntetaSTD=3
    167       REAL,SAVE :: rtetaSTD(ntetaSTD)=(/350.,380.,405./) ! Earth-specific, beware !!
    168       REAL PVteta(ngridmx,ntetaSTD)
    169 c
    170165      REAL flxwfi(ngridmx,llm)  ! Flux de masse verticale sur la grille physiq
    171166c
     
    431426
    432427      ENDDO
    433 c
    434       if (planet_type=="earth") then
    435 #ifdef CPP_PHYS
    436 ! PVtheta calls tetalevel, which is in the physics
    437 cIM calcul PV a teta=350, 380, 405K
    438       CALL PVtheta(ngridmx,llm,pucov,pvcov,pteta,
    439      $           ztfi,zplay,zplev,
    440      $           ntetaSTD,rtetaSTD,PVteta)
    441 #endif
    442       endif
    443428c
    444429c On change de grille, dynamique vers physiq, pour le flux de masse verticale
     
    491476     .             zdqfi,
    492477     .             zdpsrf,
    493 cIM diagnostique PVteta, Amip2         
    494      .             pducov,
    495      .             PVteta)
     478     .             pducov)
    496479
    497480      else if ( planet_type=="generic" ) then
  • LMDZ5/branches/testing/libf/dyn3d/conf_gcm.F

    r1999 r2056  
    22! $Id$
    33!
    4 c
    5 c
     4!
     5!
    66      SUBROUTINE conf_gcm( tapedef, etatinit, clesphy0 )
    7 c
     7!
    88      USE control_mod
    99#ifdef CPP_IOIPSL
     
    1717
    1818      IMPLICIT NONE
    19 c-----------------------------------------------------------------------
    20 c     Auteurs :   L. Fairhead , P. Le Van  .
    21 c
    22 c     Arguments :
    23 c
    24 c     tapedef   :
    25 c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para-
    26 c     -metres  du zoom  avec  celles lues sur le fichier start .
    27 c      clesphy0 :  sortie  .
    28 c
     19!-----------------------------------------------------------------------
     20!     Auteurs :   L. Fairhead , P. Le Van  .
     21!
     22!     Arguments :
     23!
     24!     tapedef   :
     25!     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para-
     26!     -metres  du zoom  avec  celles lues sur le fichier start .
     27!      clesphy0 :  sortie  .
     28!
    2929       LOGICAL etatinit
    3030       INTEGER tapedef
     
    3333       PARAMETER(     longcles = 20 )
    3434       REAL clesphy0( longcles )
    35 c
    36 c   Declarations :
    37 c   --------------
     35!
     36!   Declarations :
     37!   --------------
    3838#include "dimensions.h"
    3939#include "paramet.h"
     
    4747! #include "clesphys.h"
    4848#include "iniprint.h"
    49 c
    50 c
    51 c   local:
    52 c   ------
     49!
     50!
     51!   local:
     52!   ------
    5353
    5454      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
     
    5858      INTEGER i
    5959      LOGICAL use_filtre_fft
    60 c
    61 c  -------------------------------------------------------------------
    62 c
    63 c       .........     Version  du 29/04/97       ..........
    64 c
    65 c   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
    66 c      tetatemp   ajoutes  pour la dissipation   .
    67 c
    68 c   Autre parametre ajoute en fin de liste de tapedef : ** fxyhypb **
    69 c
    70 c  Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
    71 c    Sinon , choix de fxynew  , a derivee sinusoidale  ..
    72 c
    73 c   ......  etatinit = . TRUE. si defrun  est appele dans ETAT0_LMD  ou
    74 c         LIMIT_LMD  pour l'initialisation de start.dat (dic) et
    75 c                de limit.dat ( dic)                        ...........
    76 c           Sinon  etatinit = . FALSE .
    77 c
    78 c   Donc etatinit = .F.  si on veut comparer les valeurs de  grossismx ,
    79 c    grossismy,clon,clat, fxyhypb  lues sur  le fichier  start  avec
    80 c   celles passees  par run.def ,  au debut du gcm, apres l'appel a
    81 c    lectba . 
    82 c   Ces parmetres definissant entre autres la grille et doivent etre
    83 c   pareils et coherents , sinon il y aura  divergence du gcm .
    84 c
    85 c-----------------------------------------------------------------------
    86 c   initialisations:
    87 c   ----------------
     60!
     61!  -------------------------------------------------------------------
     62!
     63!       .........     Version  du 29/04/97       ..........
     64!
     65!   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
     66!      tetatemp   ajoutes  pour la dissipation   .
     67!
     68!   Autre parametre ajoute en fin de liste de tapedef : ** fxyhypb **
     69!
     70!  Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
     71!    Sinon , choix de fxynew  , a derivee sinusoidale  ..
     72!
     73!   ......  etatinit = . TRUE. si defrun  est appele dans ETAT0_LMD  ou
     74!         LIMIT_LMD  pour l'initialisation de start.dat (dic) et
     75!                de limit.dat ( dic)                        ...........
     76!           Sinon  etatinit = . FALSE .
     77!
     78!   Donc etatinit = .F.  si on veut comparer les valeurs de  grossismx ,
     79!    grossismy,clon,clat, fxyhypb  lues sur  le fichier  start  avec
     80!   celles passees  par run.def ,  au debut du gcm, apres l'appel a
     81!    lectba . 
     82!   Ces parmetres definissant entre autres la grille et doivent etre
     83!   pareils et coherents , sinon il y aura  divergence du gcm .
     84!
     85!-----------------------------------------------------------------------
     86!   initialisations:
     87!   ----------------
    8888
    8989!Config  Key  = lunout
     
    9595      CALL getin('lunout', lunout)
    9696      IF (lunout /= 5 .and. lunout /= 6) THEN
    97         OPEN(UNIT=lunout,FILE='lmdz.out',ACTION='write',
     97        OPEN(UNIT=lunout,FILE='lmdz.out',ACTION='write',                     &
    9898     &          STATUS='unknown',FORM='formatted')
    9999      ENDIF
     
    107107      CALL getin('prt_level',prt_level)
    108108
    109 c-----------------------------------------------------------------------
    110 c  Parametres de controle du run:
    111 c-----------------------------------------------------------------------
     109!-----------------------------------------------------------------------
     110!  Parametres de controle du run:
     111!-----------------------------------------------------------------------
    112112!Config  Key  = planet_type
    113113!Config  Desc = planet type ("earth", "mars", "venus", ...)
     
    232232       CALL getin('dissip_period',dissip_period)
    233233
    234 ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
    235 ccc
     234!cc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
     235!cc
    236236
    237237!Config  Key  = lstardis
     
    348348       CALL getin('ok_guide',ok_guide)
    349349
    350 c    ...............................................................
     350!    ...............................................................
    351351
    352352!Config  Key  =  read_start
     
    390390      ENDDO
    391391
    392 ccc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
    393 c     .........   (  modif  le 17/04/96 )   .........
    394 c
     392!cc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
     393!     .........   (  modif  le 17/04/96 )   .........
     394!
    395395      IF( etatinit ) GO TO 100
    396396
     
    411411       CALL getin('clat',clatt)
    412412
    413 c
    414 c
     413!
     414!
    415415      IF( ABS(clat - clatt).GE. 0.001 )  THEN
    416         write(lunout,*)'conf_gcm: La valeur de clat passee par run.def',
     416        write(lunout,*)'conf_gcm: La valeur de clat passee par run.def',     &
    417417     &    ' est differente de celle lue sur le fichier  start '
    418418        STOP
     
    429429
    430430      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
    431         write(lunout,*)'conf_gcm: La valeur de grossismx passee par ',
     431        write(lunout,*)'conf_gcm: La valeur de grossismx passee par ',       &
    432432     &  'run.def est differente de celle lue sur le fichier  start '
    433433        STOP
     
    443443
    444444      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
    445         write(lunout,*)'conf_gcm: La valeur de grossismy passee par ',
     445        write(lunout,*)'conf_gcm: La valeur de grossismy passee par ',        &
    446446     & 'run.def est differente de celle lue sur le fichier  start '
    447447        STOP
     
    449449     
    450450      IF( grossismx.LT.1. )  THEN
    451         write(lunout,*)
     451        write(lunout,*)                                                        &
    452452     &       'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
    453453         STOP
     
    458458
    459459      IF( grossismy.LT.1. )  THEN
    460         write(lunout,*)
     460        write(lunout,*)                                                        &
    461461     &       'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
    462462         STOP
     
    466466
    467467      write(lunout,*)'conf_gcm: alphax alphay',alphax,alphay
    468 c
    469 c    alphax et alphay sont les anciennes formulat. des grossissements
    470 c
    471 c
     468!
     469!    alphax et alphay sont les anciennes formulat. des grossissements
     470!
     471!
    472472
    473473!Config  Key  = fxyhypb
     
    482482         IF( fxyhypbb )     THEN
    483483            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
    484             write(lunout,*)' *** fxyhypb lu sur le fichier start est ',
    485      *       'F alors  qu il est  T  sur  run.def  ***'
     484            write(lunout,*)' *** fxyhypb lu sur le fichier start est ',     &
     485     &       'F alors  qu il est  T  sur  run.def  ***'
    486486              STOP
    487487         ENDIF
     
    489489         IF( .NOT.fxyhypbb )   THEN
    490490            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
    491             write(lunout,*)' ***  fxyhypb lu sur le fichier start est ',
    492      *        'T alors  qu il est  F  sur  run.def  ****  '
     491            write(lunout,*)' ***  fxyhypb lu sur le fichier start est ',     &
     492     &        'T alors  qu il est  F  sur  run.def  ****  '
    493493              STOP
    494494         ENDIF
    495495      ENDIF
    496 c
     496!
    497497!Config  Key  = dzoomx
    498498!Config  Desc = extension en longitude
     
    505505      IF( fxyhypb )  THEN
    506506       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
    507         write(lunout,*)'conf_gcm: La valeur de dzoomx passee par ',
    508      *  'run.def est differente de celle lue sur le fichier  start '
     507        write(lunout,*)'conf_gcm: La valeur de dzoomx passee par ',         &
     508     &  'run.def est differente de celle lue sur le fichier  start '
    509509        STOP
    510510       ENDIF
     
    521521      IF( fxyhypb )  THEN
    522522       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
    523         write(lunout,*)'conf_gcm: La valeur de dzoomy passee par ',
    524      * 'run.def est differente de celle lue sur le fichier  start '
     523        write(lunout,*)'conf_gcm: La valeur de dzoomy passee par ',          &
     524     & 'run.def est differente de celle lue sur le fichier  start '
    525525        STOP
    526526       ENDIF
     
    536536      IF( fxyhypb )  THEN
    537537       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
    538         write(lunout,*)'conf_gcm: La valeur de taux passee par ',
    539      * 'run.def est differente de celle lue sur le fichier  start '
     538        write(lunout,*)'conf_gcm: La valeur de taux passee par ',           &
     539     & 'run.def est differente de celle lue sur le fichier  start '
    540540        STOP
    541541       ENDIF
     
    551551      IF( fxyhypb )  THEN
    552552       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
    553         write(lunout,*)'conf_gcm: La valeur de tauy passee par ',
    554      * 'run.def est differente de celle lue sur le fichier  start '
     553        write(lunout,*)'conf_gcm: La valeur de tauy passee par ',           &
     554     & 'run.def est differente de celle lue sur le fichier  start '
    555555        STOP
    556556       ENDIF
    557557      ENDIF
    558558
    559 cc
     559!c
    560560      IF( .NOT.fxyhypb  )  THEN
    561561
     
    572572          IF( ysinuss )     THEN
    573573            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
    574             write(lunout,*)' *** ysinus lu sur le fichier start est F',
    575      *       ' alors  qu il est  T  sur  run.def  ***'
     574            write(lunout,*)' *** ysinus lu sur le fichier start est F',     &
     575     &       ' alors  qu il est  T  sur  run.def  ***'
    576576            STOP
    577577          ENDIF
     
    579579          IF( .NOT.ysinuss )   THEN
    580580            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
    581             write(lunout,*)' *** ysinus lu sur le fichier start est T',
    582      *        ' alors  qu il est  F  sur  run.def  ****  '
     581            write(lunout,*)' *** ysinus lu sur le fichier start est T',     &
     582     &        ' alors  qu il est  F  sur  run.def  ****  '
    583583              STOP
    584584          ENDIF
    585585        ENDIF
    586586      ENDIF ! of IF( .NOT.fxyhypb  )
    587 c
     587!
    588588!Config  Key  = offline
    589589!Config  Desc = Nouvelle eau liquide
     
    682682
    683683      RETURN
    684 c   ...............................................
    685 c
     684!   ...............................................
     685!
    686686100   CONTINUE
    687687!Config  Key  = clon
     
    718718
    719719      IF( grossismx.LT.1. )  THEN
    720         write(lunout,*)
    721      &   'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
     720        write(lunout,*)'conf_gcm: ***ATTENTION !! grossismx < 1 . *** '
    722721         STOP
    723722      ELSE
     
    727726
    728727      IF( grossismy.LT.1. )  THEN
    729         write(lunout,*)
    730      &  'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
     728        write(lunout,*) 'conf_gcm: ***ATTENTION !! grossismy < 1 . *** '
    731729         STOP
    732730      ELSE
     
    735733
    736734      write(lunout,*)'conf_gcm: alphax alphay ',alphax,alphay
    737 c
    738 c    alphax et alphay sont les anciennes formulat. des grossissements
    739 c
    740 c
     735!
     736!    alphax et alphay sont les anciennes formulat. des grossissements
     737!
     738!
    741739
    742740!Config  Key  = fxyhypb
     
    786784       ysinus = .TRUE.
    787785       CALL getin('ysinus',ysinus)
    788 c
     786!
    789787!Config  Key  = offline
    790788!Config  Desc = Nouvelle eau liquide
     
    864862      vert_prof_dissip = merge(1, 0, ok_strato .and. llm==39)
    865863      CALL getin('vert_prof_dissip', vert_prof_dissip)
    866       call assert(vert_prof_dissip == 0 .or. vert_prof_dissip ==  1,
    867      $     "bad value for vert_prof_dissip")
     864      call assert(vert_prof_dissip == 0 .or. vert_prof_dissip ==  1,        &
     865     &     "bad value for vert_prof_dissip")
    868866
    869867!Config  Key  = ok_gradsfile
     
    892890
    893891      write(lunout,*)' #########################################'
    894       write(lunout,*)' Configuration des parametres de cel0'
     892      write(lunout,*)' Configuration des parametres de cel0'                &
    895893     &             //'_limit: '
    896894      write(lunout,*)' planet_type = ', planet_type
     
    937935      write(lunout,*)' ok_limit = ', ok_limit
    938936      write(lunout,*)' ok_etat0 = ', ok_etat0
    939 c
     937!
    940938      RETURN
    941939      END
  • LMDZ5/branches/testing/libf/dyn3d/gcm.F

    r1999 r2056  
    105105      REAL ps(ip1jmp1)                       ! pression  au sol
    106106      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
    107       REAL pks(ip1jmp1)                      ! exner au  sol
    108       REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
    109       REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
    110107      REAL masse(ip1jmp1,llm)                ! masse d'air
    111108      REAL phis(ip1jmp1)                     ! geopotentiel au sol
     
    131128      data call_iniphys/.true./
    132129
    133       REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
    134130c+jld variables test conservation energie
    135131c      REAL ecin(ip1jmp1,llm),ecin0(ip1jmp1,llm)
     
    466462
    467463
    468       day_end = day_ini + nday
     464      if (nday>=0) then
     465         day_end = day_ini + nday
     466      else
     467         day_end = day_ini - nday/day_step
     468      endif
    469469      WRITE(lunout,300)day_ini,day_end
    470470 300  FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)
  • LMDZ5/branches/testing/libf/dyn3d/guide_mod.F90

    r2024 r2056  
    593593  SUBROUTINE guide_interp(psi,teta)
    594594 
     595  use exner_hyb_m, only: exner_hyb
     596  use exner_milieu_m, only: exner_milieu
    595597  IMPLICIT NONE
    596598
     
    614616  REAL, DIMENSION (iip1,jjm,llm)     :: pbary
    615617  ! Variables pour fonction Exner (P milieu couche)
    616   REAL, DIMENSION (iip1,jjp1,llm)    :: pk, pkf
    617   REAL, DIMENSION (iip1,jjp1,llm)    :: alpha, beta
     618  REAL, DIMENSION (iip1,jjp1,llm)    :: pk
    618619  REAL, DIMENSION (iip1,jjp1)        :: pks   
    619620  REAL                               :: prefkap,unskap
     
    680681    CALL pression( ip1jmp1, ap, bp, psi, p )
    681682    if (pressure_exner) then
    682       CALL exner_hyb(ip1jmp1,psi,p,alpha,beta,pks,pk,pkf)
     683      CALL exner_hyb(ip1jmp1,psi,p,pks,pk)
    683684    else
    684       CALL exner_milieu(ip1jmp1,psi,p,beta,pks,pk,pkf)
     685      CALL exner_milieu(ip1jmp1,psi,p,pks,pk)
    685686    endif
    686687!    ....  Calcul de pls , pression au milieu des couches ,en Pascals
  • LMDZ5/branches/testing/libf/dyn3d/iniacademic.F90

    r1910 r2056  
    1414#endif
    1515  USE Write_Field
     16  use exner_hyb_m, only: exner_hyb
     17  use exner_milieu_m, only: exner_milieu
    1618
    1719  !   Author:    Frederic Hourdin      original: 15/01/93
     
    5456  REAL pks(ip1jmp1)                      ! exner au  sol
    5557  REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
    56   REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
    5758  REAL phi(ip1jmp1,llm)                  ! geopotentiel
    5859  REAL ddsin,zsig,tetapv,w_pv  ! variables auxiliaires
     
    7071  integer idum
    7172
    72   REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm),zdtvr
     73  REAL zdtvr
    7374 
    7475  character(len=*),parameter :: modname="iniacademic"
     
    223224        CALL pression ( ip1jmp1, ap, bp, ps, p       )
    224225        if (pressure_exner) then
    225           CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
    226         else
    227           call exner_milieu(ip1jmp1,ps,p,beta,pks,pk,pkf)
     226          CALL exner_hyb( ip1jmp1, ps, p, pks, pk)
     227        else
     228          call exner_milieu(ip1jmp1,ps,p,pks,pk)
    228229        endif
    229230        CALL massdair(p,masse)
  • LMDZ5/branches/testing/libf/dyn3d/leapfrog.F

    r1999 r2056  
    1919     &                       iecri, ip_ebil_dyn, ok_dynzon, ok_dyn_ins,
    2020     &                       periodav, ok_dyn_ave, output_grads_dyn
     21      use exner_hyb_m, only: exner_hyb
     22      use exner_milieu_m, only: exner_milieu
     23
    2124      IMPLICIT NONE
    2225
     
    158161      character*10 string10
    159162
    160       REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
    161163      REAL :: flxw(ip1jmp1,llm)  ! flux de masse verticale
    162164
     
    196198
    197199
    198       itaufin   = nday*day_step
     200      if (nday>=0) then
     201         itaufin   = nday*day_step
     202      else
     203         itaufin   = -nday
     204      endif
    199205      itaufinp1 = itaufin +1
    200206      itau = 0
     
    217223      CALL pression ( ip1jmp1, ap, bp, ps, p       )
    218224      if (pressure_exner) then
    219         CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
     225        CALL exner_hyb( ip1jmp1, ps, p, pks, pk, pkf )
    220226      else
    221         CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
     227        CALL exner_milieu( ip1jmp1, ps, p, pks, pk, pkf )
    222228      endif
    223229
     
    373379         CALL pression (  ip1jmp1, ap, bp, ps,  p      )
    374380         if (pressure_exner) then
    375            CALL exner_hyb(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
     381           CALL exner_hyb(  ip1jmp1, ps, p,pks, pk, pkf )
    376382         else
    377            CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
     383           CALL exner_milieu( ip1jmp1, ps, p, pks, pk, pkf )
    378384         endif
     385
     386! Appel a geopot ajoute le 2014/05/08 pour garantir la convergence numerique
     387! avec dyn3dmem
     388         CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
    379389
    380390!           rdaym_ini  = itau * dtvr / daysec
     
    448458          CALL massdair(p,masse)
    449459          if (pressure_exner) then
    450             CALL exner_hyb(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
     460            CALL exner_hyb(ip1jmp1,ps,p,pks,pk,pkf)
    451461          else
    452             CALL exner_milieu(ip1jmp1,ps,p,beta,pks,pk,pkf)
     462            CALL exner_milieu(ip1jmp1,ps,p,pks,pk,pkf)
    453463          endif
    454464
     
    506516        CALL pression ( ip1jmp1, ap, bp, ps, p                  )
    507517        if (pressure_exner) then
    508           CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
     518          CALL exner_hyb( ip1jmp1, ps, p, pks, pk, pkf )
    509519        else
    510           CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
     520          CALL exner_milieu( ip1jmp1, ps, p, pks, pk, pkf )
    511521        endif
    512522        CALL massdair(p,masse)
Note: See TracChangeset for help on using the changeset viewer.