Ignore:
Timestamp:
Jun 26, 2014, 6:07:05 PM (11 years ago)
Author:
emillour
Message:

Common dynamics:
Some updates to keep up with LMDZ5 Earth model evolution
(up to LMDZ5 rev 2070). See file "DOC/chantiers/commit_importants.log"
for detailed list of changes.
Note that the updates of exner* routines change (as expected) results
at numerical roundoff level.
EM

Location:
trunk/LMDZ.COMMON/libf/dyn3d
Files:
7 edited

Legend:

Unmodified
Added
Removed

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

    r1256 r1302  
    172172      REAL unskap, pksurcp
    173173      save unskap
    174 
    175 cIM diagnostique PVteta, Amip2
    176       INTEGER,PARAMETER :: ntetaSTD=3
    177       REAL,SAVE :: rtetaSTD(ntetaSTD)=(/350.,380.,405./) ! Earth-specific, beware !!
    178       REAL PVteta(ngridmx,ntetaSTD)
    179174
    180175      REAL flxwfi(ngridmx,llm)  ! Flux de masse verticale sur la grille physiq
    … …  
    651646      ENDDO
    652647c
    653       if (planet_type=="earth") then
    654 #ifdef CPP_EARTH
    655 ! PVtheta calls tetalevel, which is in the (Earth) physics
    656 cIM calcul PV a teta=350, 380, 405K
    657       CALL PVtheta(ngridmx,llm,pucov,pvcov,pteta,
    658      $           ztfi,zplay,zplev,
    659      $           ntetaSTD,rtetaSTD,PVteta)
    660 #endif
    661       endif
    662 c
    663648c On change de grille, dynamique vers physiq, pour le flux de masse verticale
    664649      CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,flxw,flxwfi)
    … …  
    713698     .             zdqfi,
    714699     .             zdpsrf,
    715 cIM diagnostique PVteta, Amip2         
    716      .             pducov,
    717      .             PVteta)
     700     .             pducov)
    718701
    719702      else if ( planet_type=="generic" ) then

  • TabularUnified trunk/LMDZ.COMMON/libf/dyn3d/ce0l.F90

    r1019 r1302  
    11!
    2 ! $Id: ce0l.F90 1511 2011-04-28 15:21:47Z jghattas $
     2! $Id: ce0l.F90 1984 2014-02-18 09:59:29Z emillour $
    33!
    44!-------------------------------------------------------------------------------
    … …  
    3030#ifndef CPP_EARTH
    3131#include "iniprint.h"
    32   WRITE(lunout,*)'limit_netcdf: Earth-specific program, needs Earth physics'
     32  WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
    3333#else
    3434!-------------------------------------------------------------------------------
    … …  
    9494  END IF
    9595
    96   IF (grilles_gcm_netcdf) THEN
    97      WRITE(lunout,'(//)')
    98      WRITE(lunout,*) '  ***************************  '
    99      WRITE(lunout,*) '  ***  grilles_gcm_netcdf ***  '
    100      WRITE(lunout,*) '  ***************************  '
    101      WRITE(lunout,'(//)')
    102      CALL grilles_gcm_netcdf_sub(masque,phis)
    103   END IF
     96 
     97  WRITE(lunout,'(//)')
     98  WRITE(lunout,*) '  ***************************  '
     99  WRITE(lunout,*) '  ***  grilles_gcm_netcdf ***  '
     100  WRITE(lunout,*) '  ***************************  '
     101  WRITE(lunout,'(//)')
     102  CALL grilles_gcm_netcdf_sub(masque,phis)
     103
    104104#endif
    105105! of #ifndef CPP_EARTH #else
    … …  
    108108!
    109109!-------------------------------------------------------------------------------
     110

  • TabularUnified trunk/LMDZ.COMMON/libf/dyn3d/conf_gcm.F

    r1189 r1302  
    22! $Id: conf_gcm.F 1418 2010-07-19 15:11:24Z jghattas $
    33!
    4 c
    5 c
     4!
     5!
    66      SUBROUTINE conf_gcm( tapedef, etatinit )
    7 c
     7!
    88      USE control_mod
    99#ifdef CPP_IOIPSL
    … …  
    1818
    1919      IMPLICIT NONE
    20 c-----------------------------------------------------------------------
    21 c     Auteurs :   L. Fairhead , P. Le Van  .
    22 c
    23 c     Arguments :
    24 c
    25 c     tapedef   :
    26 c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para-
    27 c     -metres  du zoom  avec  celles lues sur le fichier start .
    28 c
     20!-----------------------------------------------------------------------
     21!     Auteurs :   L. Fairhead , P. Le Van  .
     22!
     23!     Arguments :
     24!
     25!     tapedef   :
     26!     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para-
     27!     -metres  du zoom  avec  celles lues sur le fichier start .
     28!
    2929       LOGICAL etatinit
    3030       INTEGER tapedef
    3131
    32 c   Declarations :
    33 c   --------------
     32!   Declarations :
     33!   --------------
    3434#include "dimensions.h"
    3535#include "paramet.h"
    … …  
    4343! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
    4444! #include "clesphys.h"
    45 c
    46 c
    47 c   local:
    48 c   ------
     45!
     46!
     47!   local:
     48!   ------
    4949
    5050      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
    … …  
    5454      INTEGER i
    5555      LOGICAL use_filtre_fft
    56 c
    57 c  -------------------------------------------------------------------
    58 c
    59 c       .........     Version  du 29/04/97       ..........
    60 c
    61 c   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
    62 c      tetatemp   ajoutes  pour la dissipation   .
    63 c
    64 c   Autre parametre ajoute en fin de liste de tapedef : ** fxyhypb **
    65 c
    66 c  Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
    67 c    Sinon , choix de fxynew  , a derivee sinusoidale  ..
    68 c
    69 c   ......  etatinit = . TRUE. si defrun  est appele dans ETAT0_LMD  ou
    70 c         LIMIT_LMD  pour l'initialisation de start.dat (dic) et
    71 c                de limit.dat ( dic)                        ...........
    72 c           Sinon  etatinit = . FALSE .
    73 c
    74 c   Donc etatinit = .F.  si on veut comparer les valeurs de  grossismx ,
    75 c    grossismy,clon,clat, fxyhypb  lues sur  le fichier  start  avec
    76 c   celles passees  par run.def ,  au debut du gcm, apres l'appel a
    77 c    lectba . 
    78 c   Ces parmetres definissant entre autres la grille et doivent etre
    79 c   pareils et coherents , sinon il y aura  divergence du gcm .
    80 c
    81 c-----------------------------------------------------------------------
    82 c   initialisations:
    83 c   ----------------
     56!
     57!  -------------------------------------------------------------------
     58!
     59!       .........     Version  du 29/04/97       ..........
     60!
     61!   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
     62!      tetatemp   ajoutes  pour la dissipation   .
     63!
     64!   Autre parametre ajoute en fin de liste de tapedef : ** fxyhypb **
     65!
     66!  Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
     67!    Sinon , choix de fxynew  , a derivee sinusoidale  ..
     68!
     69!   ......  etatinit = . TRUE. si defrun  est appele dans ETAT0_LMD  ou
     70!         LIMIT_LMD  pour l'initialisation de start.dat (dic) et
     71!                de limit.dat ( dic)                        ...........
     72!           Sinon  etatinit = . FALSE .
     73!
     74!   Donc etatinit = .F.  si on veut comparer les valeurs de  grossismx ,
     75!    grossismy,clon,clat, fxyhypb  lues sur  le fichier  start  avec
     76!   celles passees  par run.def ,  au debut du gcm, apres l'appel a
     77!    lectba . 
     78!   Ces parmetres definissant entre autres la grille et doivent etre
     79!   pareils et coherents , sinon il y aura  divergence du gcm .
     80!
     81!-----------------------------------------------------------------------
     82!   initialisations:
     83!   ----------------
    8484
    8585!Config  Key  = lunout
    … …  
    9191      CALL getin('lunout', lunout)
    9292      IF (lunout /= 5 .and. lunout /= 6) THEN
    93         OPEN(UNIT=lunout,FILE='lmdz.out',ACTION='write',
     93        OPEN(UNIT=lunout,FILE='lmdz.out',ACTION='write',                     &
    9494     &          STATUS='unknown',FORM='formatted')
    9595      ENDIF
    … …  
    103103      CALL getin('prt_level',prt_level)
    104104
    105 c-----------------------------------------------------------------------
    106 c  Parametres de controle du run:
    107 c-----------------------------------------------------------------------
     105!-----------------------------------------------------------------------
     106!  Parametres de controle du run:
     107!-----------------------------------------------------------------------
    108108!Config  Key  = planet_type
    109109!Config  Desc = planet type ("earth", "mars", "venus", ...)
    … …  
    264264       CALL getin('dissip_period',dissip_period)
    265265
    266 ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
    267 ccc
     266!cc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
     267!cc
    268268
    269269!Config  Key  = lstardis
    … …  
    430430       CALL getin('ok_guide',ok_guide)
    431431
    432 c    ...............................................................
     432!    ...............................................................
    433433
    434434!Config  Key  =  read_start
    … …  
    587587      CALL getin('ok_etat0',ok_etat0)
    588588
    589 !Config  Key  = grilles_gcm_netcdf
    590 !Config  Desc = creation de fichier grilles_gcm.nc dans create_etat0_limit
    591 !Config  Def  = n
    592       grilles_gcm_netcdf = .FALSE.
    593       CALL getin('grilles_gcm_netcdf',grilles_gcm_netcdf)
    594 
    595 c----------------------------------------
    596 c Parameters for zonal averages in the case of Titan
     589!----------------------------------------
     590! Parameters for zonal averages in the case of Titan
    597591      moyzon_mu = .false.
    598592      moyzon_ch = .false.
    … …  
    601595       CALL getin('moyzon_ch', moyzon_ch)
    602596      endif
    603 c----------------------------------------
    604 
    605 c----------------------------------------
    606 ccc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
    607 c     .........   (  modif  le 17/04/96 )   .........
    608 c
    609 C ZOOM PARAMETERS ... the ones read in start.nc prevail anyway ! (SL, 2012)
    610 c
    611 c----------------------------------------
     597!----------------------------------------
     598
     599!----------------------------------------
     600!cc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
     601!     .........   (  modif  le 17/04/96 )   .........
     602!
     603! ZOOM PARAMETERS ... the ones read in start.nc prevail anyway ! (SL, 2012)
     604!
     605!----------------------------------------
    612606      IF( etatinit ) then
    613607
    … …  
    645639
    646640      IF( grossismx.LT.1. )  THEN
    647         write(lunout,*)
    648      &   'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
     641        write(lunout,*)                                                        &
     642     &       'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
    649643         STOP
    650644      ELSE
    … …  
    654648
    655649      IF( grossismy.LT.1. )  THEN
    656         write(lunout,*)
    657      &  'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
     650        write(lunout,*)                                                        &
     651     &       'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
    658652         STOP
    659653      ELSE
    … …  
    662656
    663657      write(lunout,*)'conf_gcm: alphax alphay ',alphax,alphay
    664 c
    665 c    alphax et alphay sont les anciennes formulat. des grossissements
    666 c
    667 c
     658!
     659!    alphax et alphay sont les anciennes formulat. des grossissements
     660!
     661!
    668662
    669663!Config  Key  = fxyhypb
    … …  
    737731c
    738732      IF( ABS(clat - clatt).GE. 0.001 )  THEN
    739         write(lunout,*)'conf_gcm: La valeur de clat passee par run.def',
     733        write(lunout,*)'conf_gcm: La valeur de clat passee par run.def',     &
    740734     &    ' est differente de celle lue sur le fichier  start '
    741735        STOP
    … …  
    752746
    753747      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
    754         write(lunout,*)'conf_gcm: La valeur de grossismx passee par ',
     748        write(lunout,*)'conf_gcm: La valeur de grossismx passee par ',       &
    755749     &  'run.def est differente de celle lue sur le fichier  start '
    756750        STOP
    … …  
    766760
    767761      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
    768         write(lunout,*)'conf_gcm: La valeur de grossismy passee par ',
     762        write(lunout,*)'conf_gcm: La valeur de grossismy passee par ',        &
    769763     & 'run.def est differente de celle lue sur le fichier  start '
    770764        STOP
    … …  
    772766     
    773767      IF( grossismx.LT.1. )  THEN
    774         write(lunout,*)
     768        write(lunout,*)                                                        &
    775769     &       'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
    776770         STOP
    … …  
    781775
    782776      IF( grossismy.LT.1. )  THEN
    783         write(lunout,*)
     777        write(lunout,*)                                                        &
    784778     &       'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
    785779         STOP
    … …  
    789783
    790784      write(lunout,*)'conf_gcm: alphax alphay',alphax,alphay
    791 c
    792 c    alphax et alphay sont les anciennes formulat. des grossissements
    793 c
    794 c
     785!
     786!    alphax et alphay sont les anciennes formulat. des grossissements
     787!
     788!
    795789
    796790!Config  Key  = fxyhypb
    … …  
    805799         IF( fxyhypbb )     THEN
    806800            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
    807             write(lunout,*)' *** fxyhypb lu sur le fichier start est ',
    808      *       'F alors  qu il est  T  sur  run.def  ***'
     801            write(lunout,*)' *** fxyhypb lu sur le fichier start est ',     &
     802     &       'F alors  qu il est  T  sur  run.def  ***'
    809803              STOP
    810804         ENDIF
    … …  
    812806         IF( .NOT.fxyhypbb )   THEN
    813807            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
    814             write(lunout,*)' ***  fxyhypb lu sur le fichier start est ',
    815      *        'T alors  qu il est  F  sur  run.def  ****  '
     808            write(lunout,*)' ***  fxyhypb lu sur le fichier start est ',     &
     809     &        'T alors  qu il est  F  sur  run.def  ****  '
    816810              STOP
    817811         ENDIF
    818812      ENDIF
    819 c
     813!
    820814!Config  Key  = dzoomx
    821815!Config  Desc = extension en longitude
    … …  
    828822      IF( fxyhypb )  THEN
    829823       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
    830         write(lunout,*)'conf_gcm: La valeur de dzoomx passee par ',
    831      *  'run.def est differente de celle lue sur le fichier  start '
     824        write(lunout,*)'conf_gcm: La valeur de dzoomx passee par ',         &
     825     &  'run.def est differente de celle lue sur le fichier  start '
    832826        STOP
    833827       ENDIF
    … …  
    844838      IF( fxyhypb )  THEN
    845839       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
    846         write(lunout,*)'conf_gcm: La valeur de dzoomy passee par ',
    847      * 'run.def est differente de celle lue sur le fichier  start '
     840        write(lunout,*)'conf_gcm: La valeur de dzoomy passee par ',          &
     841     & 'run.def est differente de celle lue sur le fichier  start '
    848842        STOP
    849843       ENDIF
    … …  
    859853      IF( fxyhypb )  THEN
    860854       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
    861         write(lunout,*)'conf_gcm: La valeur de taux passee par ',
    862      * 'run.def est differente de celle lue sur le fichier  start '
     855        write(lunout,*)'conf_gcm: La valeur de taux passee par ',           &
     856     & 'run.def est differente de celle lue sur le fichier  start '
    863857        STOP
    864858       ENDIF
    … …  
    874868      IF( fxyhypb )  THEN
    875869       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
    876         write(lunout,*)'conf_gcm: La valeur de tauy passee par ',
    877      * 'run.def est differente de celle lue sur le fichier  start '
     870        write(lunout,*)'conf_gcm: La valeur de tauy passee par ',           &
     871     & 'run.def est differente de celle lue sur le fichier  start '
    878872        STOP
    879873       ENDIF
    … …  
    895889          IF( ysinuss )     THEN
    896890            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
    897             write(lunout,*)' *** ysinus lu sur le fichier start est F',
    898      *       ' alors  qu il est  T  sur  run.def  ***'
     891            write(lunout,*)' *** ysinus lu sur le fichier start est F',     &
     892     &       ' alors  qu il est  T  sur  run.def  ***'
    899893            STOP
    900894          ENDIF
    … …  
    902896          IF( .NOT.ysinuss )   THEN
    903897            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
    904             write(lunout,*)' *** ysinus lu sur le fichier start est T',
    905      *        ' alors  qu il est  F  sur  run.def  ****  '
     898            write(lunout,*)' *** ysinus lu sur le fichier start est T',     &
     899     &        ' alors  qu il est  F  sur  run.def  ****  '
    906900              STOP
    907901          ENDIF
    … …  
    910904
    911905      endif ! etatinit
    912 c----------------------------------------
     906!----------------------------------------
    913907
    914908
    … …  
    962956      write(lunout,*)' ok_limit = ', ok_limit
    963957      write(lunout,*)' ok_etat0 = ', ok_etat0
    964       write(lunout,*)' grilles_gcm_netcdf = ', grilles_gcm_netcdf
    965958      if (planet_type=="titan") then
    966959       write(lunout,*)' moyzon_mu = ', moyzon_mu

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

    r1300 r1302  
    107107      REAL ps(ip1jmp1)                       ! pression  au sol
    108108      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
    109       REAL pks(ip1jmp1)                      ! exner au  sol
    110       REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
    111       REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
    112109      REAL masse(ip1jmp1,llm)                ! masse d'air
    113110      REAL phis(ip1jmp1)                     ! geopotentiel au sol
    … …  
    133130      data call_iniphys/.true./
    134131
    135       REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
    136132c+jld variables test conservation energie
    137133c      REAL ecin(ip1jmp1,llm),ecin0(ip1jmp1,llm)
    … …  
    500496c   ------------------------
    501497
    502       day_end=day_ini+nday
     498      if (nday>=0) then ! standard case
     499        day_end=day_ini+nday
     500      else ! special case when nday <0, run -nday dynamical steps
     501        day_end=day_ini-nday/day_step
     502      endif
    503503      if (less1day) then
    504504        day_end=day_ini+floor(time_0+fractday)

  • TabularUnified trunk/LMDZ.COMMON/libf/dyn3d/guide_mod.F90

    r1300 r1302  
    437437! Sauvegarde du guidage?
    438438    f_out=((MOD(itau,iguide_sav).EQ.0).AND.guide_sav) 
    439     IF (f_out) CALL guide_out("S",jjp1,1,ps)
     439    IF (f_out) CALL guide_out("SP",jjp1,1,ps)
    440440   
    441441    if (guide_u) then
    … …  
    447447        if (guide_zon) CALL guide_zonave(1,jjp1,llm,f_add)
    448448        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_u)
    449         IF (f_out) CALL guide_out("U",jjp1,llm,f_add/factt)
     449        IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1+tau*ugui2)
     450        IF (f_out) CALL guide_out("u",jjp1,llm,ucov)
     451        IF (f_out) CALL guide_out("ucov",jjp1,llm,f_add/factt)
    450452        ucov=ucov+f_add
    451453    endif
    … …  
    459461        if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
    460462        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_T)
    461         IF (f_out) CALL guide_out("T",jjp1,llm,f_add/factt)
     463        IF (f_out) CALL guide_out("teta",jjp1,llm,f_add/factt)
    462464        teta=teta+f_add
    463465    endif
    … …  
    471473        if (guide_zon) CALL guide_zonave(2,jjp1,1,f_add(1:ip1jmp1,1))
    472474        CALL guide_addfield(ip1jmp1,1,f_add(1:ip1jmp1,1),alpha_P)
    473         IF (f_out) CALL guide_out("P",jjp1,1,f_add(1:ip1jmp1,1)/factt)
     475        IF (f_out) CALL guide_out("ps",jjp1,1,f_add(1:ip1jmp1,1)/factt)
    474476        ps=ps+f_add(1:ip1jmp1,1)
    475477        CALL pression(ip1jmp1,ap,bp,ps,p)
    … …  
    485487        if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
    486488        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_Q)
    487         IF (f_out) CALL guide_out("Q",jjp1,llm,f_add/factt)
     489        IF (f_out) CALL guide_out("q",jjp1,llm,f_add/factt)
    488490        q=q+f_add
    489491    endif
    … …  
    497499        if (guide_zon) CALL guide_zonave(2,jjm,llm,f_add(1:ip1jm,:))
    498500        CALL guide_addfield(ip1jm,llm,f_add(1:ip1jm,:),alpha_v)
    499         IF (f_out) CALL guide_out("V",jjm,llm,f_add(1:ip1jm,:)/factt)
     501        IF (f_out) CALL guide_out("v",jjm,llm,vcov)
     502        IF (f_out) CALL guide_out("va",jjm,llm,(1.-tau)*vgui1+tau*vgui2)
     503        IF (f_out) CALL guide_out("vcov",jjm,llm,f_add(1:ip1jm,:)/factt)
    500504        vcov=vcov+f_add(1:ip1jm,:)
    501505    endif
    … …  
    589593  SUBROUTINE guide_interp(psi,teta)
    590594 
     595  use exner_hyb_m, only: exner_hyb
     596  use exner_milieu_m, only: exner_milieu
    591597  IMPLICIT NONE
    592598
    … …  
    610616  REAL, DIMENSION (iip1,jjm,llm)     :: pbary
    611617  ! Variables pour fonction Exner (P milieu couche)
    612   REAL, DIMENSION (iip1,jjp1,llm)    :: pk, pkf
    613   REAL, DIMENSION (iip1,jjp1,llm)    :: alpha, beta
     618  REAL, DIMENSION (iip1,jjp1,llm)    :: pk
    614619  REAL, DIMENSION (iip1,jjp1)        :: pks   
    615620  REAL                               :: prefkap,unskap
    … …  
    676681    CALL pression( ip1jmp1, ap, bp, psi, p )
    677682    if (pressure_exner) then
    678       CALL exner_hyb(ip1jmp1,psi,p,alpha,beta,pks,pk,pkf)
     683      CALL exner_hyb(ip1jmp1,psi,p,pks,pk)
    679684    else
    680       CALL exner_milieu(ip1jmp1,psi,p,beta,pks,pk,pkf)
     685      CALL exner_milieu(ip1jmp1,psi,p,pks,pk)
    681686    endif
    682687!    ....  Calcul de pls , pression au milieu des couches ,en Pascals
    … …  
    15071512   
    15081513    ! Variables entree
    1509     CHARACTER, INTENT(IN)                          :: varname
     1514    CHARACTER*(*), INTENT(IN)                          :: varname
    15101515    INTEGER,   INTENT (IN)                         :: hsize,vsize
    15111516    REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field
    … …  
    15161521    INTEGER       :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev
    15171522    INTEGER       :: vid_lonu,vid_lonv,vid_latu,vid_latv,vid_cu,vid_cv,vid_lev
     1523    INTEGER       :: vid_au,vid_av
    15181524    INTEGER, DIMENSION (3) :: dim3
    15191525    INTEGER, DIMENSION (4) :: dim4,count,start
    1520     INTEGER                :: ierr, varid
     1526    INTEGER                :: ierr, varid,l
     1527    REAL, DIMENSION (iip1,hsize,vsize) :: field2
    15211528
    15221529    print *,'Guide: output timestep',timestep,'var ',varname
    … …  
    15421549        ierr=NF_DEF_VAR(nid,"LEVEL",NF_FLOAT,1,id_lev,vid_lev)
    15431550        ierr=NF_DEF_VAR(nid,"cu",NF_FLOAT,2,(/id_lonu,id_latu/),vid_cu)
     1551        ierr=NF_DEF_VAR(nid,"au",NF_FLOAT,2,(/id_lonu,id_latu/),vid_au)
    15441552        ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv)
     1553        ierr=NF_DEF_VAR(nid,"av",NF_FLOAT,2,(/id_lonv,id_latv/),vid_av)
    15451554       
    15461555        ierr=NF_ENDDEF(nid)
    … …  
    15551564        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu)
    15561565        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cv,cv)
     1566        ierr = NF_PUT_VAR_DOUBLE(nid,vid_au,alpha_u)
     1567        ierr = NF_PUT_VAR_DOUBLE(nid,vid_av,alpha_v)
    15571568#else
    15581569        ierr = NF_PUT_VAR_REAL(nid,vid_lonu,rlonu*180./pi)
    … …  
    15631574        ierr = NF_PUT_VAR_REAL(nid,vid_cu,cu)
    15641575        ierr = NF_PUT_VAR_REAL(nid,vid_cv,cv)
     1576        ierr = NF_PUT_VAR_REAL(nid,vid_au,alpha_u)
     1577        ierr = NF_PUT_VAR_REAL(nid,vid_av,alpha_v)
    15651578#endif
    15661579! --------------------------------------------------------------------
    … …  
    15791592        IF (guide_u) THEN
    15801593            dim4=(/id_lonu,id_latu,id_lev,id_tim/)
     1594            ierr = NF_DEF_VAR(nid,"u",NF_FLOAT,4,dim4,varid)
     1595            ierr = NF_DEF_VAR(nid,"ua",NF_FLOAT,4,dim4,varid)
    15811596            ierr = NF_DEF_VAR(nid,"ucov",NF_FLOAT,4,dim4,varid)
    15821597        ENDIF
    … …  
    15841599        IF (guide_v) THEN
    15851600            dim4=(/id_lonv,id_latv,id_lev,id_tim/)
     1601            ierr = NF_DEF_VAR(nid,"v",NF_FLOAT,4,dim4,varid)
     1602            ierr = NF_DEF_VAR(nid,"va",NF_FLOAT,4,dim4,varid)
    15861603            ierr = NF_DEF_VAR(nid,"vcov",NF_FLOAT,4,dim4,varid)
    15871604        ENDIF
    … …  
    16061623    ierr=NF_OPEN("guide_ins.nc",NF_WRITE,nid)
    16071624
     1625    IF (varname=="SP") timestep=timestep+1
     1626
     1627    ierr = NF_INQ_VARID(nid,varname,varid)
    16081628    SELECT CASE (varname)
    1609     CASE ("S")
    1610         timestep=timestep+1
    1611         ierr = NF_INQ_VARID(nid,"SP",varid)
     1629    CASE ("SP","ps")
    16121630        start=(/1,1,timestep,0/)
    16131631        count=(/iip1,jjp1,1,0/)
    1614 #ifdef NC_DOUBLE
    1615         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1616 #else
    1617         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1618 #endif
    1619     CASE ("P")
    1620         ierr = NF_INQ_VARID(nid,"ps",varid)
    1621         start=(/1,1,timestep,0/)
    1622         count=(/iip1,jjp1,1,0/)
    1623 #ifdef NC_DOUBLE
    1624         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1625 #else
    1626         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1627 #endif
    1628     CASE ("U")
    1629         ierr = NF_INQ_VARID(nid,"ucov",varid)
     1632    CASE ("v","va","vcov")
     1633        start=(/1,1,1,timestep/)
     1634        count=(/iip1,jjm,llm,1/)
     1635    CASE DEFAULT
    16301636        start=(/1,1,1,timestep/)
    16311637        count=(/iip1,jjp1,llm,1/)
     1638    END SELECT
     1639
     1640    SELECT CASE (varname)
     1641    CASE("u","ua")
     1642        DO l=1,llm ; field2(:,2:jjm,l)=field(:,2:jjm,l)/cu(:,2:jjm) ; ENDDO
     1643        field2(:,1,:)=0. ; field2(:,jjp1,:)=0.
     1644    CASE("v","va")
     1645        DO l=1,llm ; field2(:,:,l)=field(:,:,l)/cv(:,:) ; ENDDO
     1646    CASE DEFAULT
     1647        field2=field
     1648    END SELECT
     1649
     1650
    16321651#ifdef NC_DOUBLE
    1633         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
     1652    ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field2)
    16341653#else
    1635         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
     1654    ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field2)
    16361655#endif
    1637     CASE ("V")
    1638         ierr = NF_INQ_VARID(nid,"vcov",varid)
    1639         start=(/1,1,1,timestep/)
    1640         count=(/iip1,jjm,llm,1/)
    1641 #ifdef NC_DOUBLE
    1642         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1643 #else
    1644         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1645 #endif
    1646     CASE ("T")
    1647         ierr = NF_INQ_VARID(nid,"teta",varid)
    1648         start=(/1,1,1,timestep/)
    1649         count=(/iip1,jjp1,llm,1/)
    1650 #ifdef NC_DOUBLE
    1651         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1652 #else
    1653         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1654 #endif
    1655     CASE ("Q")
    1656         ierr = NF_INQ_VARID(nid,"q",varid)
    1657         start=(/1,1,1,timestep/)
    1658         count=(/iip1,jjp1,llm,1/)
    1659 #ifdef NC_DOUBLE
    1660         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1661 #else
    1662         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    1663 #endif
    1664     END SELECT
    1665  
     1656
    16661657    ierr = NF_CLOSE(nid)
    16671658

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

    r1189 r1302  
    2020     &                       ok_dynzon,periodav,ok_dyn_ave,iecri,
    2121     &                       ok_dyn_ins,output_grads_dyn
     22      use exner_hyb_m, only: exner_hyb
     23      use exner_milieu_m, only: exner_milieu
    2224      use cpdet_mod, only: cpdet,tpot2t,t2tpot
    2325      use sponge_mod, only: callsponge,mode_sponge,sponge
    … …  
    217219      endif
    218220
    219       itaufin   = nday*day_step
     221      if (nday>=0) then
     222         itaufin   = nday*day_step
     223      else
     224         ! to run a given (-nday) number of dynamical steps
     225         itaufin   = -nday
     226      endif
    220227      if (less1day) then
    221228c MODIF VENUS: to run less than one day:
    … …  
    262269      CALL pression ( ip1jmp1, ap, bp, ps, p       )
    263270      if (pressure_exner) then
    264         CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
     271        CALL exner_hyb( ip1jmp1, ps, p, pks, pk, pkf )
    265272      else
    266         CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
     273        CALL exner_milieu( ip1jmp1, ps, p, pks, pk, pkf )
    267274      endif
    268275
    … …  
    476483         CALL pression (  ip1jmp1, ap, bp, ps,  p      )
    477484         if (pressure_exner) then
    478            CALL exner_hyb(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
     485           CALL exner_hyb(  ip1jmp1, ps, p,pks, pk, pkf )
    479486         else
    480            CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
     487           CALL exner_milieu( ip1jmp1, ps, p, pks, pk, pkf )
    481488         endif
     489
     490! Compute geopotential (physics might need it)
     491         CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
    482492
    483493           jD_cur = jD_ref + day_ini - day_ref +                        &
    … …  
    551561          CALL massdair(p,masse)
    552562          if (pressure_exner) then
    553             CALL exner_hyb(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
     563            CALL exner_hyb( ip1jmp1, ps, p, pks, pk, pkf )
    554564          else
    555             CALL exner_milieu(ip1jmp1,ps,p,beta,pks,pk,pkf)
     565            CALL exner_milieu( ip1jmp1, ps, p, pks, pk, pkf )
    556566          endif
    557567         
    … …  
    604614        CALL pression ( ip1jmp1, ap, bp, ps, p                  )
    605615        if (pressure_exner) then
    606           CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
     616          CALL exner_hyb( ip1jmp1, ps, p, pks, pk, pkf )
    607617        else
    608           CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
     618          CALL exner_milieu( ip1jmp1, ps, p, pks, pk, pkf )
    609619        endif
    610620        CALL massdair(p,masse)

  • TabularUnified trunk/LMDZ.COMMON/libf/dyn3d/logic.h

    r1056 r1302  
    1111     &  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus       &
    1212     &  ,read_start,ok_guide,ok_strato,tidal,ok_gradsfile               &
    13      &  ,ok_limit,ok_etat0,grilles_gcm_netcdf,hybrid                    &
     13     &  ,ok_limit,ok_etat0,hybrid                                       &
    1414     &  ,moyzon_mu,moyzon_ch
    1515
    … …  
    1919     & apdiss,apdelq,saison,ecripar,fxyhypb,ysinus                      &
    2020     &  ,read_start,ok_guide,ok_strato,tidal,ok_gradsfile               &
    21      &  ,ok_limit,ok_etat0,grilles_gcm_netcdf
     21     &  ,ok_limit,ok_etat0
     22
    2223      logical hybrid ! vertical coordinate is hybrid if true (sigma otherwise)
    2324                     ! (only used if disvert_type==2)
Note: See TracChangeset for help on using the changeset viewer.