Ignore:
Timestamp:
Dec 10, 2009, 10:02:56 AM (15 years ago)
Author:
Laurent Fairhead
Message:

Merged LMDZ4-dev branch changes r1241:1278 into the trunk
Running trunk and LMDZ4-dev in LMDZOR configuration on local
machine (sequential) and SX8 (4-proc) yields identical results
(restart and restartphy are identical binarily)
Log history from r1241 to r1278 is available by switching to
source:LMDZ4/branches/LMDZ4-dev-20091210

Location:
LMDZ4/trunk
Files:
6 deleted
41 edited
2 copied

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk

  • LMDZ4/trunk/libf/dyn3d/abort_gcm.F

    r1147 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44c
    … …  
    88#ifdef CPP_IOIPSL
    99      USE IOIPSL
     10#else
     11! if not using IOIPSL, we still need to use (a local version of) getin_dump
     12      USE ioipsl_getincom
    1013#endif
    1114#include "iniprint.h"

  • LMDZ4/trunk/libf/dyn3d/advtrac.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44c
    … …  
    3030#include "ener.h"
    3131#include "description.h"
     32#include "iniprint.h"
    3233
    3334c-------------------------------------------------------------------
    … …  
    7475      DATA dum/.true./
    7576
     77      integer,save :: countcfl=0
     78      real cflx(ip1jmp1,llm)
     79      real cfly(ip1jm,llm)
     80      real cflz(ip1jmp1,llm)
     81      real, save :: cflxmax(llm),cflymax(llm),cflzmax(llm)
    7682
    7783      IF(iadvtr.EQ.0) THEN
    … …  
    139145         ENDDO
    140146
     147
     148c-------------------------------------------------------------------
     149! Calcul des criteres CFL en X, Y et Z
     150c-------------------------------------------------------------------
     151
     152      if (countcfl == 0. ) then
     153          cflxmax(:)=0.
     154          cflymax(:)=0.
     155          cflzmax(:)=0.
     156      endif
     157
     158      countcfl=countcfl+iapp_tracvl
     159      cflx(:,:)=0.
     160      cfly(:,:)=0.
     161      cflz(:,:)=0.
     162      do l=1,llm
     163         do ij=iip2,ip1jm-1
     164            if (pbarug(ij,l)>=0.) then
     165                cflx(ij,l)=pbarug(ij,l)*dtvr/masse(ij,l)
     166            else
     167                cflx(ij,l)=-pbarug(ij,l)*dtvr/masse(ij+1,l)
     168            endif
     169         enddo
     170      enddo
     171      do l=1,llm
     172         do ij=iip2,ip1jm-1,iip1
     173            cflx(ij+iip1,l)=cflx(ij,l)
     174         enddo
     175      enddo
     176
     177      do l=1,llm
     178         do ij=1,ip1jm
     179            if (pbarvg(ij,l)>=0.) then
     180                cfly(ij,l)=pbarvg(ij,l)*dtvr/masse(ij,l)
     181            else
     182                cfly(ij,l)=-pbarvg(ij,l)*dtvr/masse(ij+iip1,l)
     183            endif
     184         enddo
     185      enddo
     186
     187      do l=2,llm
     188         do ij=1,ip1jm
     189            if (wg(ij,l)>=0.) then
     190                cflz(ij,l)=wg(ij,l)*dtvr/masse(ij,l)
     191            else
     192                cflz(ij,l)=-wg(ij,l)*dtvr/masse(ij,l-1)
     193            endif
     194         enddo
     195      enddo
     196
     197      do l=1,llm
     198         cflxmax(l)=max(cflxmax(l),maxval(cflx(:,l)))
     199         cflymax(l)=max(cflymax(l),maxval(cfly(:,l)))
     200         cflzmax(l)=max(cflzmax(l),maxval(cflz(:,l)))
     201      enddo
     202
     203!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     204! Par defaut, on sort le diagnostic des CFL tous les jours.
     205! Si on veut le sortir a chaque pas d'advection en cas de plantage
     206!     if (countcfl==iapp_tracvl) then
     207!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     208      if (countcfl==day_step) then
     209         do l=1,llm
     210         write(lunout,*) 'L, CFLmax '
     211     s   ,l,maxval(cflx(:,l)),maxval(cfly(:,l)),maxval(cflz(:,l))
     212         enddo
     213         countcfl=0
     214      endif
     215   
    141216c-------------------------------------------------------------------
    142217c   Advection proprement dite (Modification Le Croller (07/2001)

  • LMDZ4/trunk/libf/dyn3d/bilan_dyn.F

    r693 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      SUBROUTINE bilan_dyn (ntrac,dt_app,dt_cum,
    … …  
    1010c             vQ..A=Cp T + L * ...
    1111
     12#ifdef CPP_IOIPSL
    1213      USE IOIPSL
     14#endif
    1315
    1416      IMPLICIT NONE

  • LMDZ4/trunk/libf/dyn3d/caladvtrac.F

    r1146 r1279  
    7676           ENDDO
    7777          ENDDO
    78 
    79           CALL qminimum( q, 2, finmasse )
     78         
     79          if (planet_type.eq."earth") then
     80! Earth-specific treatment of first 2 tracers (water)
     81            CALL qminimum( q, 2, finmasse )
     82          endif
    8083
    8184          CALL SCOPY   ( ip1jmp1*llm, masse, 1, finmasse,       1 )

  • LMDZ4/trunk/libf/dyn3d/calfis.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44C
    55C
    66      SUBROUTINE calfis(lafin,
    7      $                  rdayvrai,
    8      $                  heure,
     7     $                  jD_cur, jH_cur,
    98     $                  pucov,
    109     $                  pvcov,
    … …  
    102101c    -----------
    103102      LOGICAL  lafin
    104       REAL heure
     103
    105104
    106105      REAL pvcov(iip1,jjm,llm)
    … …  
    170169      DATA firstcal/.true./
    171170      SAVE firstcal,debut
    172       REAL rdayvrai
     171!      REAL rdayvrai
     172      REAL, intent(in):: jD_cur, jH_cur
    173173c
    174174c-----------------------------------------------------------------------
    … …  
    177177c    --------------------
    178178c
    179 
    180       IF (ngridmx.NE.2+(jjm-1)*iim) THEN
     179c
     180      IF ( firstcal )  THEN
     181        debut = .TRUE.
     182        IF (ngridmx.NE.2+(jjm-1)*iim) THEN
    181183         PRINT*,'STOP dans calfis'
    182184         PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
    … …  
    184186         PRINT*,ngridmx,jjm,iim
    185187         STOP
    186       ENDIF
    187 
    188 c-----------------------------------------------------------------------
    189 c   latitude, longitude et aires des mailles pour la physique:
    190 c   ----------------------------------------------------------
    191 
    192 c
    193       IF ( firstcal )  THEN
    194           debut = .TRUE.
     188        ENDIF
    195189      ELSE
    196           debut = .FALSE.
    197       ENDIF
     190        debut = .FALSE.
     191      ENDIF ! of IF (firstcal)
    198192
    199193c
    … …  
    290284
    291285c   convergence dynamique pour les traceurs "EAU"
    292 
    293       DO iq=1,2
     286! Earth-specific treatment of first 2 tracers (water)
     287       if (planet_type=="earth") then
     288        DO iq=1,2
    294289         DO l=1,llm
    295290            pcvgq(1,l,iq)= pdq(1,1,l,iq) / pmasse(1,1,l)
    … …  
    303298            pcvgq(ig0,l,iq)= pdq(1,jjp1,l,iq) / pmasse(1,jjp1,l)
    304299         ENDDO
    305       ENDDO
     300        ENDDO
     301       endif ! of if (planet_type=="earth")
    306302
    307303
    … …  
    428424      ENDDO
    429425c
     426      if (planet_type=="earth") then
     427#ifdef CPP_EARTH
    430428cIM calcul PV a teta=350, 380, 405K
    431429      CALL PVtheta(ngridmx,llm,pucov,pvcov,pteta,
    432430     $           ztfi,zplay,zplev,
    433431     $           ntetaSTD,rtetaSTD,PVteta)
     432#endif
     433      endif
    434434c
    435435c On change de grille, dynamique vers physiq, pour le flux de masse verticale
    … …  
    441441
    442442
     443      if (planet_type=="earth") then
     444#ifdef CPP_EARTH
    443445      CALL physiq (ngridmx,
    444446     .             llm,
    445447     .             debut,
    446448     .             lafin,
    447      .             rdayvrai,
    448      .             heure,
     449     .             jD_cur,
     450     .             jH_cur,
    449451     .             dtphys,
    450452     .             zplev,
    … …  
    467469     .             pducov,
    468470     .             PVteta)
     471#endif
     472      endif !of if (planet_type=="earth")
    469473
    470474500   CONTINUE
    … …  
    502506c   62. humidite specifique
    503507c   ---------------------
    504 
    505       DO iq=1,nqtot
    506          DO l=1,llm
    507             DO i=1,iip1
    508                pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)
    509                pdqfi(i,jjp1,l,iq) = zdqfi(ngridmx,l,iq)
    510             ENDDO
    511             DO j=2,jjm
    512                ig0=1+(j-2)*iim
    513                DO i=1,iim
    514                   pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)
    515                ENDDO
    516                pdqfi(iip1,j,l,iq) = pdqfi(1,j,l,iq)
    517             ENDDO
    518          ENDDO
    519       ENDDO
     508! Ehouarn: removed this useless bit: was overwritten at step 63 anyways
     509!      DO iq=1,nqtot
     510!         DO l=1,llm
     511!            DO i=1,iip1
     512!               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)
     513!               pdqfi(i,jjp1,l,iq) = zdqfi(ngridmx,l,iq)
     514!            ENDDO
     515!            DO j=2,jjm
     516!               ig0=1+(j-2)*iim
     517!               DO i=1,iim
     518!                  pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)
     519!               ENDDO
     520!               pdqfi(iip1,j,l,iq) = pdqfi(1,j,l,iq)
     521!            ENDDO
     522!         ENDDO
     523!      ENDDO
    520524
    521525c   63. traceurs
    522526c   ------------
    523527C     initialisation des tendances
    524       pdqfi=0.
     528      pdqfi(:,:,:,:)=0.
    525529C
    526530      DO iq=1,nqtot

  • LMDZ4/trunk/libf/dyn3d/coefpoly.F

    r524 r1279  
    1919c  On en revient a resoudre un systeme de 4 equat.a 4 inconnues a0,a1,a2,a3
    2020
    21       REAL*8 Xf1, Xf2,Xprim1,Xprim2, xtild1,xtild2, xi
    22       REAL*8 Xfout, Xprim
    23       REAL*8 a1,a2,a3,a0, xtil1car, xtil2car,derr,x1x2car
     21      REAL(KIND=8) Xf1, Xf2,Xprim1,Xprim2, xtild1,xtild2, xi
     22      REAL(KIND=8) Xfout, Xprim
     23      REAL(KIND=8) a1,a2,a3,a0, xtil1car, xtil2car,derr,x1x2car
    2424
    2525      xtil1car = xtild1 * xtild1

  • LMDZ4/trunk/libf/dyn3d/comconst.h

    r1107 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44!-----------------------------------------------------------------------
    … …  
    77      COMMON/comconst/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,           &
    88     & dtvr,daysec,                                                     &
    9      & pi,dtphys,dtdiss,rad,r,cpp,kappa,cotot,unsim,g,omeg
     9     & pi,dtphys,dtdiss,rad,r,cpp,kappa,cotot,unsim,g,omeg              &
     10     &                   ,dissip_factz,dissip_deltaz,dissip_zref        &
     11     &                   ,iflag_top_bound,tau_top_bound
     12
    1013
    1114      INTEGER im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl
    … …  
    1316      REAL pi,dtphys,dtdiss,rad,r,cpp,kappa
    1417      REAL cotot,unsim,g,omeg
     18      REAL dissip_factz,dissip_deltaz,dissip_zref
     19      INTEGER iflag_top_bound
     20      REAL tau_top_bound
     21
    1522
    1623!-----------------------------------------------------------------------

  • LMDZ4/trunk/libf/dyn3d/comvert.h

    r524 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    4 c-----------------------------------------------------------------------
    5 c   INCLUDE 'comvert.h'
     4!-----------------------------------------------------------------------
     5!   INCLUDE 'comvert.h'
    66
    7       COMMON/comvert/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm) ,
    8      ,               pa,preff,nivsigs(llm),nivsig(llm+1)
     7      COMMON/comvert/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm),      &
     8     &               pa,preff,nivsigs(llm),nivsig(llm+1)
    99
    1010      REAL ap,bp,presnivs,dpres,pa,preff,nivsigs,nivsig
    1111
    12 c-----------------------------------------------------------------------
     12 !-----------------------------------------------------------------------

  • LMDZ4/trunk/libf/dyn3d/conf_gcm.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44c
    … …  
    3838#include "serre.h"
    3939#include "comdissnew.h"
     40#include "temps.h"
     41#include "comconst.h"
    4042
    4143! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
    … …  
    111113      CALL getin('planet_type',planet_type)
    112114
     115!Config  Key  = calend
     116!Config  Desc = type de calendrier utilise
     117!Config  Def  = earth_360d
     118!Config  Help = valeur possible: earth_360d, earth_365d, earth_366d
     119!Config         
     120      calend = 'earth_360d'
     121      CALL getin('calend', calend)
     122
    113123!Config  Key  = dayref
    114124!Config  Desc = Jour de l'etat initial
    … …  
    267277       tetatemp  = 7200.
    268278       CALL getin('tetatemp',tetatemp )
     279
     280! Parametres controlant la variation sur la verticale des constantes de
     281! dissipation.
     282! Pour le moment actifs uniquement dans la version a 39 niveaux
     283! avec ok_strato=y
     284
     285       dissip_factz=4.
     286       dissip_deltaz=10.
     287       dissip_zref=30.
     288       CALL getin('dissip_factz',dissip_factz )
     289       CALL getin('dissip_deltaz',dissip_deltaz )
     290       CALL getin('dissip_zref',dissip_zref )
     291
     292       iflag_top_bound=1
     293       tau_top_bound=1.e-5
     294       CALL getin('iflag_top_bound',iflag_top_bound)
     295       CALL getin('tau_top_bound',tau_top_bound)
    269296
    270297!Config  Key  = coefdis
    … …  
    558585      write(lunout,*)' Configuration des parametres du gcm: '
    559586      write(lunout,*)' planet_type = ', planet_type
     587      write(lunout,*)' calend = ', calend
    560588      write(lunout,*)' dayref = ', dayref
    561589      write(lunout,*)' anneeref = ', anneeref
    … …  
    744772      write(lunout,*)' Configuration des parametres du gcm: '
    745773      write(lunout,*)' planet_type = ', planet_type
     774      write(lunout,*)' calend = ', calend
    746775      write(lunout,*)' dayref = ', dayref
    747776      write(lunout,*)' anneeref = ', anneeref

  • LMDZ4/trunk/libf/dyn3d/create_etat0_limit.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44       PROGRAM create_etat0_limit
     5#ifdef CPP_EARTH
     6! This prog. is designed to work for Earth
    57       USE dimphy
    68       USE comgeomphy
    79       USE infotrac
     10#ifdef CPP_IOIPSL
     11       use ioipsl, only: ioconf_calendar
     12#endif
     13       IMPLICIT NONE
    814c
    915c
    … …  
    4147      END IF
    4248
    43       CALL Init_Phys_lmdz(iim,jjp1,llm,1,(jjm-1)*iim+2)
     49      CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
     50      PRINT *,'---> klon=',klon
    4451      call InitComgeomphy
     52
     53#ifdef CPP_IOIPSL
     54      call ioconf_calendar('360d')
     55#endif
    4556
    4657      WRITE(6,*) '  *********************  '
    … …  
    59701     FORMAT(//)
    6071
     72#endif
     73! of #ifdef CPP_EARTH
    6174      STOP
    6275      END

  • LMDZ4/trunk/libf/dyn3d/diagedyn.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44
    … …  
    315315C
    316316#else
    317       write(lunout,*),'diagedyn: Needs Earth physics to function'
     317      write(lunout,*)'diagedyn: Needs Earth physics to function'
    318318#endif
    319319! #endif of #ifdef CPP_EARTH

  • LMDZ4/trunk/libf/dyn3d/disvert.F

    r999 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
    … …  
    3636c
    3737      INTEGER l
    38       REAL snorm
     38      REAL snorm,dsigmin
    3939      REAL alpha,beta,gama,delta,deltaz,h
    4040      INTEGER np,ierr
    … …  
    9696      WRITE(LUNOUT,*)'WARNING!!! Ancienne discretisation verticale'
    9797
     98      if (ok_strato) then
     99         if (llm==39) then
     100            dsigmin=0.3
     101         else if (llm==50) then
     102            dsigmin=1.
     103         else
     104            WRITE(LUNOUT,*) 'ATTENTION discretisation z a ajuster'
     105            dsigmin=1.
     106         endif
     107         WRITE(LUNOUT,*) 'Discretisation verticale DSIGMIN=',dsigmin
     108      endif
     109
    98110      h=7.
    99111      snorm  = 0.
    … …  
    102114
    103115         IF (ok_strato) THEN
    104            dsig(l) =(1.0 + 7.0 * SIN(x)**2)
     116           dsig(l) =(dsigmin + 7.0 * SIN(x)**2)
    105117     &            *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2       
    106118         ELSE
    … …  
    149161c
    150162      ENDDO
     163
     164      bp(1)=1.
     165      ap(1)=0.
     166
    151167      ap(llmp1) = pa * ( sig(llmp1) - bp(llmp1) )
    152168

  • LMDZ4/trunk/libf/dyn3d/dump2d.F

    r524 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      SUBROUTINE dump2d(im,jm,z,nom_z)
    … …  
    66      INTEGER im,jm
    77      REAL z(im,jm)
    8       CHARACTER*80 nom_z
     8      CHARACTER (len=*) :: nom_z
    99
    1010      INTEGER i,j,imin,illm,jmin,jllm
    1111      REAL zmin,zllm
    1212
    13       PRINT*,nom_z
     13      WRITE(*,*) "dump2d: ",trim(nom_z)
    1414
    1515      zmin=z(1,1)
    … …  
    3939
    4040      IF(zllm.GT.zmin) THEN
    41       DO j=1,jm
    42       WRITE(*,'(72i1)') (NINT(10.*(z(i,j)-zmin)/(zllm-zmin)),i=1,im)
    43       ENDDO
     41       DO j=1,jm
     42        WRITE(*,'(600i1)') (NINT(10.*(z(i,j)-zmin)/(zllm-zmin)),i=1,im)
     43       ENDDO
    4444      ENDIF
    4545      RETURN

  • LMDZ4/trunk/libf/dyn3d/dynredem.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44c
    55      SUBROUTINE dynredem0(fichnom,iday_end,phis)
     6#ifdef CPP_IOIPSL
    67      USE IOIPSL
     8#endif
    79      USE infotrac
    810      IMPLICIT NONE
    … …  
    5557
    5658c-----------------------------------------------------------------------
    57       modname='dynredem'
    58 
     59      modname='dynredem0'
     60
     61#ifdef CPP_IOIPSL
    5962      call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
    6063      call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
    61        
     64#else
     65! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
     66      yyears0=0
     67      mmois0=1
     68      jjour0=1
     69#endif       
    6270
    6371      DO l=1,length

  • LMDZ4/trunk/libf/dyn3d/etat0_netcdf.F

    r1146 r1279  
    1414      USE phys_state_var_mod
    1515      USE filtreg_mod
     16      use regr_lat_time_climoz_m, only: regr_lat_time_climoz
     17      use conf_phys_m, only: conf_phys
    1618#endif
    1719!#endif of #ifdef CPP_EARTH
     20      use netcdf, only: nf90_open, NF90_NOWRITE, nf90_close
    1821      !
    1922      IMPLICIT NONE
    2023      !
    21 #include "netcdf.inc"
    2224#include "dimensions.h"
    2325#include "paramet.h"
    … …  
    4951      REAL :: vvent(iip1, jjm, llm)
    5052      REAL :: t3d(iip1, jjp1, llm), tpot(iip1, jjp1, llm)
    51       REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: q3d
    5253      REAL :: qsat(iip1, jjp1, llm)
     54      REAL,ALLOCATABLE :: q3d(:, :, :,:)
    5355      REAL :: tsol(klon), qsol(klon), sn(klon)
    54       REAL :: tsolsrf(klon,nbsrf), qsolsrf(klon,nbsrf),snsrf(klon,nbsrf)
     56!!      REAL :: tsolsrf(klon,nbsrf)
     57      real qsolsrf(klon,nbsrf),snsrf(klon,nbsrf)
    5558      REAL :: albe(klon,nbsrf), evap(klon,nbsrf)
    5659      REAL :: alblw(klon,nbsrf)
    … …  
    7275      !
    7376
    74       CHARACTER*80 :: varname
     77      CHARACTER(len=80) :: varname
    7578      !
    7679      INTEGER :: i,j, ig, l, ji,ii1,ii2
    … …  
    102105      REAL :: w(ip1jmp1,llm)
    103106      REAL ::phystep
    104       REAL :: rugsrel(iip1*jjp1)
     107CC      REAL :: rugsrel(iip1*jjp1)
    105108      REAL :: fder(klon)
    106       real zrel(iip1*jjp1),chmin,chmax
    107 
    108       CHARACTER*80 :: visu_file
     109!!      real zrel(iip1*jjp1),chmin,chmax
     110
     111!!      CHARACTER(len=80) :: visu_file
    109112      INTEGER :: visuid
    110113
    … …  
    126129      logical              :: ok_journe, ok_mensuel, ok_instan, ok_hf
    127130      logical              :: ok_LES
    128       LOGICAL              :: ok_ade, ok_aie, aerosol_couple
     131      LOGICAL              :: ok_ade, ok_aie, aerosol_couple, new_aod
     132      INTEGER              :: flag_aerosol
    129133      REAL                 :: bl95_b0, bl95_b1
    130134      real                 :: fact_cldcon, facttemps,ratqsbas,ratqshaut
     135      real                 :: tau_ratqs
    131136      integer              :: iflag_cldcon
    132137      integer              :: iflag_ratqs
    … …  
    140145      real :: seuil_inversion
    141146
     147      integer  read_climoz ! read ozone climatology
     148C     Allowed values are 0, 1 and 2
     149C     0: do not read an ozone climatology
     150C     1: read a single ozone climatology that will be used day and night
     151C     2: read two ozone climatologies, the average day and night
     152C     climatology and the daylight climatology
     153
    142154      !
    143155      !   Constantes
    … …  
    162174!      CALL defrun_new(99,.TRUE.,clesphy0)
    163175      CALL conf_gcm( 99, .TRUE. , clesphy0 )
    164       call conf_phys(ok_journe, ok_mensuel, ok_instan,                  &
    165      &                 ok_hf, ok_LES,                                   &
     176      call conf_phys(  ok_journe, ok_mensuel, ok_instan, ok_hf, ok_LES, &
    166177     &                 solarlong0,seuil_inversion,                      &
    167178     &                 fact_cldcon, facttemps,ok_newmicro,iflag_radia,  &
    168179     &                 iflag_cldcon,                                    &
    169      &                 iflag_ratqs,ratqsbas,ratqshaut,                  &
     180     &                 iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs,        &
    170181     &                 ok_ade, ok_aie, aerosol_couple,                  &
     182     &                 flag_aerosol, new_aod,                           &
    171183     &                 bl95_b0, bl95_b1,                                &
    172184     &                 iflag_thermals,nsplit_thermals,tau_thermals,     &
    173185     &                 iflag_thermals_ed,iflag_thermals_optflux,        &
    174      &                 iflag_coupl,iflag_clos,iflag_wake )
     186     &                 iflag_coupl,iflag_clos,iflag_wake, read_climoz )
     187
     188! co2_ppm0 : initial value of atmospheric CO2 from .def file (co2_ppm value)
     189      co2_ppm0 = co2_ppm
     190
    175191      dtvr   = daysec/FLOAT(day_step)
    176192      print*,'dtvr',dtvr
    177193
    178 
    179 
    180194      CALL iniconst()
    181195      CALL inigeom()
    182196
    183197! Initialisation pour traceurs
    184       CALL infotrac_init
    185       ALLOCATE(q3d(iip1,jjp1,llm,nqtot))
    186 
     198      call infotrac_init
     199      ALLOCATE(q3d(iip1, jjp1, llm, nqtot))
    187200
    188201      CALL inifilr()
    189       CALL phys_state_var_init()
     202      CALL phys_state_var_init(read_climoz)
    190203      !
    191204      latfi(1) = ASIN(1.0)
    … …  
    244257
    245258      write(*,*)'Essai de lecture masque ocean'
    246       iret = nf_open("o2a.nc", NF_NOWRITE, nid_o2a)
     259      iret = nf90_open("o2a.nc", NF90_NOWRITE, nid_o2a)
    247260      if (iret .ne. 0) then
    248261        write(*,*)'ATTENTION!! pas de fichier o2a.nc trouve'
    … …  
    263276      else
    264277        couple = .true.
    265         iret = nf_close(nid_o2a)
     278        iret = nf90_close(nid_o2a)
    266279        call flininfo("o2a.nc", iml_omask, jml_omask, llm_tmp, ttm_tmp
    267280     $    , nid_o2a)
    … …  
    400413     .                           maxval(qsat(:,:,:))
    401414      !
    402       WRITE(*,*) 'QSAT :', qsat(10,20,:)
     415CC      WRITE(*,*) 'QSAT :', qsat(10,20,:)
    403416      !
    404417      varname = 'q'
    … …  
    411424      q3d(:,:,:,1) = qd(:,:,:)
    412425      !
     426
     427!     Ozone climatology:
     428      if (read_climoz >= 1) call regr_lat_time_climoz(read_climoz)
     429
    413430      varname = 'tsol'
    414431      ! This line needs to be replaced by a call to restget to get the values in the restart file
    … …  
    475492     .     jjm, rlonu, rlatv , interbar )
    476493c
    477       rugsrel(:) = 0.0
    478       IF(ok_orodr)  THEN
    479         DO i = 1, iip1* jjp1
    480          rugsrel(i) = MAX( 1.e-05, zstd(i)* zsig(i) /2. )
    481         ENDDO
    482       ENDIF
     494cc      rugsrel(:) = 0.0
     495cc      IF(ok_orodr)  THEN
     496cc        DO i = 1, iip1* jjp1
     497cc         rugsrel(i) = MAX( 1.e-05, zstd(i)* zsig(i) /2. )
     498cc        ENDDO
     499cc      ENDIF
    483500
    484501
    … …  
    650667      itau_phy = 0
    651668      iday = dayref +itau/day_step
    652       time = FLOAT(itau-(iday-dayref)*day_step)/day_step
     669      time = real(itau-(iday-dayref)*day_step)/day_step
    653670c     
    654671      IF(time.GT.1)  THEN
    … …  
    714731      q_ancien = 0.
    715732      agesno = 0.
     733c
    716734      frugs(1:klon,is_oce) = rugmer(1:klon)
    717735      frugs(1:klon,is_ter) = MAX(1.0e-05, zstd(1:klon)*zsig(1:klon)/2.0)
    … …  
    750768
    751769C     Sortie Visu pour les champs dynamiques
    752       if (1.eq.0 ) then
    753       print*,'sortie visu'
    754       time_step = 1.
    755       t_ops = 2.
    756       t_wrt = 2.
    757       itau = 2.
    758       visu_file='Etat0_visu.nc'
    759       CALL initdynav(visu_file,dayref,anneeref,time_step,
    760      .              t_ops, t_wrt, visuid)
    761       CALL writedynav(visuid, itau,vvent ,
    762      .                uvent,tpot,pk,phi,q3d,masse,psol,phis)
    763       else
     770cc      if (1.eq.0 ) then
     771cc      print*,'sortie visu'
     772cc      time_step = 1.
     773cc      t_ops = 2.
     774cc      t_wrt = 2.
     775cc      itau = 2.
     776cc      visu_file='Etat0_visu.nc'
     777cc      CALL initdynav(visu_file,dayref,anneeref,time_step,
     778cc     .              t_ops, t_wrt, visuid)
     779cc      CALL writedynav(visuid, itau,vvent ,
     780cc     .                uvent,tpot,pk,phi,q3d,masse,psol,phis)
     781cc      else
    764782         print*,'CCCCCCCCCCCCCCCCCC REACTIVER SORTIE VISU DANS ETAT0'
    765       endif
     783cc      endif
    766784      print*,'entree histclo'
    767785      CALL histclo
    768 
    769       DEALLOCATE(q3d)
    770786
    771787#endif
    … …  
    774790      !
    775791      END SUBROUTINE etat0_netcdf
    776 

  • LMDZ4/trunk/libf/dyn3d/fluxstokenc.F

    r1146 r1279  
     1!
     2! $Id$
     3!
    14      SUBROUTINE fluxstokenc(pbaru,pbarv,masse,teta,phi,phis,
    25     . time_step,itau )
     6#ifdef CPP_EARTH
     7! This routine is designed to work for Earth and with ioipsl
    38
    49       USE IOIPSL
    … …  
    1823#include "tracstoke.h"
    1924#include "temps.h"
     25#include "iniprint.h"
    2026
    2127      REAL time_step,t_wrt, t_ops
    … …  
    159165      ENDIF ! if iadvtr.EQ.istdyn
    160166
     167#else
     168      write(lunout,*)
     169     & 'fluxstokenc: Needs Earth physics (and ioipsl) to function'
     170#endif
     171! of #ifdef CPP_EARTH
    161172      RETURN
    162173      END

  • LMDZ4/trunk/libf/dyn3d/fxhyp.F

    r650 r1279  
    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.)

  • LMDZ4/trunk/libf/dyn3d/fxyhyper.F

    r524 r1279  
    4141       REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1),
    4242     , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
    43        REAL*8  dxmin, dxmax , dymin, dymax
     43       REAL(KIND=8)  dxmin, dxmax , dymin, dymax
    4444
    4545c   ....   var. locales   .....

  • LMDZ4/trunk/libf/dyn3d/fyhyp.F

    r650 r1279  
    5050     
    5151       REAL   dzoom
    52        REAL*8 ylat(jjp1), yprim(jjp1)
    53        REAL*8 yuv
    54        REAL*8 yt(0:nmax2)
    55        REAL*8 fhyp(0:nmax2),beta,Ytprim(0:nmax2),fxm(0:nmax2)
     52       REAL(KIND=8) ylat(jjp1), yprim(jjp1)
     53       REAL(KIND=8) yuv
     54       REAL(KIND=8) yt(0:nmax2)
     55       REAL(KIND=8) fhyp(0:nmax2),beta,Ytprim(0:nmax2),fxm(0:nmax2)
    5656       SAVE Ytprim, yt,Yf
    57        REAL*8 Yf(0:nmax2),yypr(0:nmax2)
    58        REAL*8 yvrai(jjp1), yprimm(jjp1),ylatt(jjp1)
    59        REAL*8 pi,depi,pis2,epsilon,y0,pisjm
    60        REAL*8 yo1,yi,ylon2,ymoy,Yprimin,champmin,champmax
    61        REAL*8 yfi,Yf1,ffdy
    62        REAL*8 ypn,deply,y00
     57       REAL(KIND=8) Yf(0:nmax2),yypr(0:nmax2)
     58       REAL(KIND=8) yvrai(jjp1), yprimm(jjp1),ylatt(jjp1)
     59       REAL(KIND=8) pi,depi,pis2,epsilon,y0,pisjm
     60       REAL(KIND=8) yo1,yi,ylon2,ymoy,Yprimin,champmin,champmax
     61       REAL(KIND=8) yfi,Yf1,ffdy
     62       REAL(KIND=8) ypn,deply,y00
    6363       SAVE y00, deply
    6464
    … …  
    6666       INTEGER jpn,jjpn
    6767       SAVE jpn
    68        REAL*8 a0,a1,a2,a3,yi2,heavyy0,heavyy0m
    69        REAL*8 fa(0:nmax2),fb(0:nmax2)
     68       REAL(KIND=8) a0,a1,a2,a3,yi2,heavyy0,heavyy0m
     69       REAL(KIND=8) fa(0:nmax2),fb(0:nmax2)
    7070       REAL y0min,y0max
    7171
    72        REAL*8     heavyside
     72       REAL(KIND=8)     heavyside
    7373
    7474       pi       = 2. * ASIN(1.)

  • LMDZ4/trunk/libf/dyn3d/gcm.F

    r1147 r1279  
     1!
     2! $Id$
     3!
    14c
    25c
    … …  
    110113      real time_step, t_wrt, t_ops
    111114
    112       REAL rdayvrai,rdaym_ini,rday_ecri
    113115      LOGICAL first
    114116
    … …  
    132134      character (len=20) :: modname
    133135      character (len=80) :: abort_message
    134 
    135 C Calendrier
    136       LOGICAL true_calendar
    137       PARAMETER (true_calendar = .false.)
     136! locales pour gestion du temps
     137      INTEGER :: an, mois, jour
     138      REAL :: heure
     139
    138140
    139141c-----------------------------------------------------------------------
    … …  
    160162
    161163
    162 c-----------------------------------------------------------------------
    163 c   Choix du calendrier
    164 c   -------------------
    165 
    166 #ifdef CPP_IOIPSL
    167       if (true_calendar) then
    168         call ioconf_calendar('gregorian')
    169       else
    170         call ioconf_calendar('360d')
    171       endif
    172 #endif
    173164c----------------------------------------------------------------------
    174165c  lecture des fichiers gcm.def ou run.def
    … …  
    194185      endif
    195186!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     187c-----------------------------------------------------------------------
     188c   Choix du calendrier
     189c   -------------------
     190
     191c      calend = 'earth_365d'
     192
     193#ifdef CPP_IOIPSL
     194      if (calend == 'earth_360d') then
     195        call ioconf_calendar('360d')
     196        write(lunout,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
     197      else if (calend == 'earth_365d') then
     198        call ioconf_calendar('noleap')
     199        write(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
     200      else if (calend == 'earth_366d') then
     201        call ioconf_calendar('gregorian')
     202        write(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
     203      else
     204        abort_message = 'Mauvais choix de calendrier'
     205        call abort_gcm(modname,abort_message,1)
     206      endif
     207#endif
     208c-----------------------------------------------------------------------
    196209
    197210      IF (config_inca /= 'none') THEN
    … …  
    294307     .  ' restart ne correspondent pas a celles lues dans '
    295308        write(lunout,*)' gcm.def'
     309        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
     310        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
    296311        if (raz_date .ne. 1) then
    297312          write(lunout,*)
    … …  
    310325        raz_date = 0
    311326      endif
     327
    312328#ifdef CPP_IOIPSL
    313       call ioconf_startdate(annee_ref,0,day_ref, 0.)
    314 #endif
    315 
     329      mois = 1
     330      heure = 0.
     331      call ymds2ju(annee_ref, mois, day_ref, heure, jD_ref)
     332      jH_ref = jD_ref - int(jD_ref)
     333      jD_ref = int(jD_ref)
     334
     335      call ioconf_startdate(INT(jD_ref), jH_ref)
     336
     337      write(lunout,*)'DEBUG'
     338      write(lunout,*)'annee_ref, mois, day_ref, heure, jD_ref'
     339      write(lunout,*)annee_ref, mois, day_ref, heure, jD_ref
     340      call ju2ymds(jD_ref+jH_ref,an, mois, jour, heure)
     341      write(lunout,*)'jD_ref+jH_ref,an, mois, jour, heure'
     342      write(lunout,*)jD_ref+jH_ref,an, mois, jour, heure
     343#else
     344! Ehouarn: we still need to define JD_ref and JH_ref
     345! and since we don't know how many days there are in a year
     346! we set JD_ref to 0 (this should be improved ...)
     347      jD_ref=0
     348      jH_ref=0
     349#endif
    316350
    317351c  nombre d'etats dans les fichiers demarrage et histoire
    … …  
    388422 300  FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)
    389423
     424#ifdef CPP_IOIPSL
     425      call ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure)
     426      write (lunout,301)jour, mois, an
     427      call ju2ymds(jD_ref + day_end - day_ref, an, mois, jour, heure)
     428      write (lunout,302)jour, mois, an
     429 301  FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4)
     430 302  FORMAT('1'/,15x,'    au ', i2,'/',i2,'/',i4)
     431#endif
     432
    390433      if (planet_type.eq."earth") then
    391 #ifdef CPP_EARTH
    392       CALL dynredem0("restart.nc", day_end, phis)
    393 #endif
     434        CALL dynredem0("restart.nc", day_end, phis)
    394435      endif
    395436
    … …  
    401442      t_ops = iecri * daysec
    402443      t_wrt = iecri * daysec
    403       CALL inithist(dynhist_file,day_ref,annee_ref,time_step,
    404      .              t_ops, t_wrt, histid, histvid)
    405 
    406       IF (ok_dynzon) THEN
    407          t_ops = iperiod * time_step
    408          t_wrt = periodav * daysec
    409          CALL initdynav(dynhistave_file,day_ref,annee_ref,time_step,
    410      .        t_ops, t_wrt, histaveid)
    411       END IF
     444!      CALL inithist(dynhist_file,day_ref,annee_ref,time_step,
     445!    .              t_ops, t_wrt, histid, histvid)
     446
     447!     IF (ok_dynzon) THEN
     448!        t_ops = iperiod * time_step
     449!        t_wrt = periodav * daysec
     450!        CALL initdynav(dynhistave_file,day_ref,annee_ref,time_step,
     451!    .        t_ops, t_wrt, histaveid)
     452!     END IF
    412453      dtav = iperiod*dtvr/daysec
    413454      endif

  • LMDZ4/trunk/libf/dyn3d/getparam.F90

    r524 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44MODULE getparam
     5#ifdef CPP_IOIPSL
    56   USE IOIPSL
     7#else
     8! if not using IOIPSL, we still need to use (a local version of) getin
     9   USE ioipsl_getincom
     10#endif
     11
    612   INTERFACE getpar
    713     MODULE PROCEDURE ini_getparam,fin_getparam,getparamr,getparami,getparaml

  • LMDZ4/trunk/libf/dyn3d/grid_atob.F

    r524 r1279  
    700700      PARAMETER (imtmp=360,jmtmp=180)
    701701      REAL xtmp(imtmp), ytmp(jmtmp)
    702       REAL*8 cham1tmp(imtmp,jmtmp), cham2tmp(imtmp,jmtmp)
     702      REAL(KIND=8) cham1tmp(imtmp,jmtmp), cham2tmp(imtmp,jmtmp)
    703703      REAL zzzz
    704704c
    … …  
    859859              number(ii,jj) = number(ii,jj) + 1.0
    860860              rugs(ii,jj) = rugs(ii,jj)
    861      .                       + LOG(MAX(0.001,cham2tmp(i,j)))
     861     .                       + LOG(MAX(0.001_8,cham2tmp(i,j)))
    862862          ENDIF
    863863          ENDDO
    … …  
    892892         i_proche = ij_proche - (j_proche-1)*imtmp
    893893         PRINT*, "solution:", ij_proche, i_proche, j_proche
    894          rugs(i,j) = LOG(MAX(0.001,cham2tmp(i_proche,j_proche)))
     894         rugs(i,j) = LOG(MAX(0.001_8,cham2tmp(i_proche,j_proche)))
    895895         ENDIF
    896896      ENDDO

  • LMDZ4/trunk/libf/dyn3d/groupeun.F

    r1146 r1279  
    1919      REAL airecs,qs
    2020
    21       INTEGER i,j,l,ig,j1,j2,i0,jd
     21      INTEGER i,j,l,ig,ig2,j1,j2,i0,jd
    2222
    2323c--------------------------------------------------------------------c
    … …  
    3737
    3838      LOGICAL, SAVE :: first = .TRUE.
     39      INTEGER,SAVE :: i_index(iim,ngroup)
     40      INTEGER      :: offset
     41      REAL         :: qsum(iim/ngroup)
    3942
    4043      IF (first) THEN
    … …  
    4346      ENDIF
    4447
     48
    4549c Champs 3D
    4650      jd=jjp1-jjmax
    47 
     51c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    4852      DO l=1,llm
    4953         j1=1+jd
    … …  
    5458            j_start  = j1-jd
    5559            j_finish = j2-jd
    56             DO j=j_start, j_finish
    57                DO i0=1,iim,2**(ngroup-ig+1)
    58                   qn=0.
    59                   DO i=i0,i0+2**(ngroup-ig+1)-1
    60                      qn=qn+q(i,j,l)
    61                   ENDDO
    62                   DO i=i0,i0+2**(ngroup-ig+1)-1
    63                      q(i,j,l)=qn*airen_tab(i,j,jd)
    64                   ENDDO
     60            DO ig2=1,ngroup-ig+1
     61              offset=2**(ig2-1)
     62              DO j=j_start, j_finish
     63!CDIR NODEP
     64!CDIR ON_ADB(q)
     65                 DO i0=1,iim,2**ig2
     66                   q(i0,j,l)=q(i0,j,l)+q(i0+offset,j,l)
     67                 ENDDO
     68              ENDDO
     69            ENDDO
     70           
     71            DO j=j_start, j_finish
     72!CDIR NODEP
     73!CDIR ON_ADB(q)
     74               DO i=1,iim
     75                 q(i,j,l)=q(i-MOD(i-1,2**(ngroup-ig+1)),j,l)
     76               ENDDO
     77            ENDDO
     78
     79            DO j=j_start, j_finish
     80!CDIR ON_ADB(airen_tab)
     81!CDIR ON_ADB(q)
     82               DO i=1,iim
     83                 q(i,j,l)=q(i,j,l)*airen_tab(i,j,jd)
    6584               ENDDO
    6685               q(iip1,j,l)=q(1,j,l)
    6786            ENDDO
    68         
     87       
    6988!c     Concerne le pole sud
    7089            j_start  = j1-jd
    7190            j_finish = j2-jd
    72             DO j=j_start, j_finish
    73                DO i0=1,iim,2**(ngroup-ig+1)
    74                   qs=0.
    75                   DO i=i0,i0+2**(ngroup-ig+1)-1
    76                      qs=qs+q(i,jjp1-j+1-jd,l)
    77                   ENDDO
    78                   DO i=i0,i0+2**(ngroup-ig+1)-1
    79                      q(i,jjp1-j+1-jd,l)=qs*aires_tab(i,jjp1-j+1,jd)
    80                   ENDDO
     91            DO ig2=1,ngroup-ig+1
     92              offset=2**(ig2-1)
     93              DO j=j_start, j_finish
     94!CDIR NODEP
     95!CDIR ON_ADB(q)
     96                 DO i0=1,iim,2**ig2
     97                   q(i0,jjp1-j+1-jd,l)= q(i0,jjp1-j+1-jd,l)
     98     &                                 +q(i0+offset,jjp1-j+1-jd,l)
     99                 ENDDO
     100              ENDDO
     101            ENDDO
     102
     103
     104            DO j=j_start, j_finish
     105!CDIR NODEP
     106!CDIR ON_ADB(q)
     107               DO i=1,iim
     108                 q(i,jjp1-j+1-jd,l)=q(i-MOD(i-1,2**(ngroup-ig+1)),
     109     &                                jjp1-j+1-jd,l)
     110               ENDDO
     111            ENDDO
     112
     113            DO j=j_start, j_finish
     114!CDIR ON_ADB(aires_tab)
     115!CDIR ON_ADB(q)
     116               DO i=1,iim
     117                 q(i,jjp1-j+1-jd,l)=q(i,jjp1-j+1-jd,l)* 
     118     &                              aires_tab(i,jjp1-j+1,jd)
    81119               ENDDO
    82120               q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
    83121            ENDDO
     122
    84123       
    85124            j1=j2+1
    … …  
    87126         ENDDO
    88127      ENDDO
     128!$OMP END DO NOWAIT
    89129
    90130      RETURN
    91131      END
    92 
    93 
    94 
     132     
     133     
     134     
     135     
    95136      SUBROUTINE INIT_GROUPEUN(airen_tab, aires_tab)
    96137      IMPLICIT NONE

  • LMDZ4/trunk/libf/dyn3d/heavyside.F

    r524 r1279  
    1010       IMPLICIT NONE
    1111
    12        REAL*8 heavyside , a
     12       REAL(KIND=8) heavyside , a
    1313
    1414       IF ( a.LE.0. )  THEN

  • LMDZ4/trunk/libf/dyn3d/infotrac.F90

    r1146 r1279  
     1! $Id$
     2!
    13MODULE infotrac
    24
    … …  
    1921  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: niadv ! equivalent dyn / physique
    2022
    21 ! Variables for INCA
     23! conv_flg(it)=0 : convection desactivated for tracer number it
    2224  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: conv_flg
     25! pbl_flg(it)=0  : boundary layer diffusion desactivaded for tracer number it
    2326  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: pbl_flg
    2427
     28  CHARACTER(len=4),SAVE :: type_trac
     29 
    2530CONTAINS
    2631
    … …  
    5156    INTEGER, ALLOCATABLE, DIMENSION(:) :: vadv  ! index of vertical trasport schema
    5257
    53     CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
     58    CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
    5459    CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: tracnam ! name from INCA
    5560    CHARACTER(len=3), DIMENSION(30) :: descrq
    … …  
    7883    descrq(20)='SLP'
    7984    descrq(30)='PRA'
     85   
     86
     87    IF (config_inca=='none') THEN
     88       type_trac='lmdz'
     89    ELSE
     90       type_trac='inca'
     91    END IF
    8092
    8193!-----------------------------------------------------------------------
    … …  
    8597!
    8698!-----------------------------------------------------------------------
    87     IF (config_inca == 'none') THEN
     99    IF (type_trac == 'lmdz') THEN
    88100       OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
    89101       IF(ierr.EQ.0) THEN
    … …  
    107119    END IF
    108120!
    109 ! Allocate variables depending on nqtrue
     121! Allocate variables depending on nqtrue and nbtr
    110122!
    111123    ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue))
    112 
    113     IF (config_inca /= 'none') THEN
    114        ! Varaibles only needed in case of INCA
    115        ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), tracnam(nbtr))
    116     END IF
    117        
     124    ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), tracnam(nbtr))
     125    conv_flg(:) = 1 ! convection activated for all tracers
     126    pbl_flg(:)  = 1 ! boundary layer activated for all tracers
     127
    118128!-----------------------------------------------------------------------
    119129! 2)     Choix  des schemas d'advection pour l'eau et les traceurs
    … …  
    142152!    Get choice of advection schema from file tracer.def or from INCA
    143153!---------------------------------------------------------------------
    144     IF (config_inca == 'none') THEN
     154    IF (type_trac == 'lmdz') THEN
    145155       IF(ierr.EQ.0) THEN
    146156          ! Continue to read tracer.def
    … …  
    170180       END DO
    171181
    172     ELSE  ! config_inca='aero' ou 'chem'
     182    ELSE  ! type_trac=inca : config_inca='aero' ou 'chem'
    173183! le module de chimie fournit les noms des traceurs
    174184! et les schemas d'advection associes.
    … …  
    189199       END DO
    190200
    191     END IF ! config_inca
     201    END IF ! type_trac
    192202
    193203!-----------------------------------------------------------------------
    … …  
    293303
    294304
    295     WRITE(lunout,*) 'Information stored in dimtrac :'
     305    WRITE(lunout,*) 'Information stored in infotrac :'
    296306    WRITE(lunout,*) 'iadv  niadv tname  ttext :'
    297307    DO iq=1,nqtot
    … …  
    299309    END DO
    300310
     311!
     312! Test for advection schema.
     313! This version of LMDZ only garantees iadv=10 and iadv=14 (14 only for water vapour) .
     314!
     315    DO iq=1,nqtot
     316       IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN
     317          WRITE(lunout,*)'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
     318          CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1)
     319       ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN
     320          WRITE(lunout,*)'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
     321          CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
     322       END IF
     323    END DO
     324
    301325!-----------------------------------------------------------------------
    302326! Finalize :
    303327!
    304328    DEALLOCATE(tnom_0, hadv, vadv)
    305     IF (config_inca /= 'none') DEALLOCATE(tracnam)
    306 
    307 999 FORMAT (i2,1x,i2,1x,a8)
     329    DEALLOCATE(tracnam)
     330
     331999 FORMAT (i2,1x,i2,1x,a15)
    308332
    309333  END SUBROUTINE infotrac_init

  • LMDZ4/trunk/libf/dyn3d/ini_paramLMDZ_dyn.h

    r956 r1279  
    22      dt_cum = dtvr*day_step
    33
    4       zan = annee_ref
    5       dayref = day_ref
    6       CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
     4!      zan = annee_ref
     5!      dayref = day_ref
     6!      CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
    77      tau0 = itau_dyn
    88c
    … …  
    1515     .                 iip1,rlong, jjp1,rlatg,
    1616     .                 1,1,1,1,
    17      .                 tau0, zjulian, dt_cum,
     17     .                 tau0, jD_ref+jH_ref , dt_cum,
    1818     .                 thoriid, nid_ctesGCM)
    1919c
    … …  
    134134c
    135135         CALL histdef(nid_ctesGCM, "true_calendar",
    136      ."Choix du calendrier: 1=gregorien ,0=calen. a 360 j",
     136     ."Choix du calendrier",
    137137     .                "-",iip1,jjp1,thoriid, 1,1,1, -99, 32,
    138138     .                "once", dt_cum,dt_cum)

  • LMDZ4/trunk/libf/dyn3d/iniacademic.F

    r1146 r1279  
    8383c
    8484        time_0=0.
     85        day_ref=0
     86        annee_ref=0
    8587
    8688        im         = iim

  • LMDZ4/trunk/libf/dyn3d/inidissip.F

    r524 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      SUBROUTINE inidissip ( lstardis,nitergdiv,nitergrot,niterh  ,
    … …  
    1818#include "comvert.h"
    1919#include "control.h"
     20#include "logic.h"
    2021
    2122      LOGICAL lstardis
    … …  
    2930      INTEGER l,ij,idum,ii
    3031      REAL tetamin
     32      REAL pseudoz
    3133
    3234      REAL ran1
    … …  
    174176c   --------------------------------------------------
    175177
    176       DO l=1,llm
    177          zvert(l)=1.
    178       ENDDO
    179 
    180       fact=2.
    181 c
    182       DO l = 1, llm
    183          zz      = 1. - preff/presnivs(l)
    184          zvert(l)= fact -( fact-1.)/( 1.+zz*zz )
    185       ENDDO
     178      if (ok_strato .and. llm==39) then
     179         do l=1,llm
     180            pseudoz=8.*log(preff/presnivs(l))
     181            zvert(l)=1+
     182     s      (tanh((pseudoz-dissip_zref)/dissip_deltaz)+1.)/2.
     183     s      *(dissip_factz-1.)
     184         enddo
     185      else
     186         DO l=1,llm
     187            zvert(l)=1.
     188         ENDDO
     189         fact=2.
     190         DO l = 1, llm
     191            zz      = 1. - preff/presnivs(l)
     192            zvert(l)= fact -( fact-1.)/( 1.+zz*zz )
     193         ENDDO
     194      endif
    186195
    187196

  • LMDZ4/trunk/libf/dyn3d/integrd.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      SUBROUTINE integrd
    … …  
    3232#include "temps.h"
    3333#include "serre.h"
     34#include "control.h"
    3435
    3536c   Arguments:
    … …  
    183184c$$$      ENDIF
    184185
    185          DO l = 1, llm
    186           DO ij = 1, ip1jmp1
    187            deltap(ij,l) =  p(ij,l) - p(ij,l+1)
     186         if (planet_type.eq."earth") then
     187! Earth-specific treatment of first 2 tracers (water)
     188          DO l = 1, llm
     189           DO ij = 1, ip1jmp1
     190            deltap(ij,l) =  p(ij,l) - p(ij,l+1)
     191           ENDDO
    188192          ENDDO
    189          ENDDO
    190 
    191          CALL qminimum( q, nq, deltap )
     193
     194          CALL qminimum( q, nq, deltap )
     195         endif ! of if (planet_type.eq."earth")
     196
    192197c
    193198c    .....  Calcul de la valeur moyenne, unique  aux poles pour  q .....

  • LMDZ4/trunk/libf/dyn3d/inter_barx.F

    r790 r1279  
    212212     
    213213
    214 3      FORMAT(1x,70(1h-))
     2143      FORMAT(1x,70("-"))
    2152152      FORMAT(1x,8f8.2)
    216216

  • LMDZ4/trunk/libf/dyn3d/leapfrog.F

    r1146 r1279  
     1!
     2! $Id$
    13!
    24c
    … …  
    1113#endif
    1214      USE infotrac
    13 
     15      USE guide_mod, ONLY : guide_main
     16      USE write_field
    1417      IMPLICIT NONE
    1518
    … …  
    111114c
    112115      INTEGER itau,itaufinp1,iav
    113       INTEGER*4  iday ! jour julien
    114       REAL       time ! Heure de la journee en fraction d'1 jour
     116!      INTEGER  iday ! jour julien
     117      REAL       time
    115118
    116119      REAL  SSUM
    … …  
    124127      real time_step, t_wrt, t_ops
    125128
    126       REAL rdayvrai,rdaym_ini
     129!      REAL rdayvrai,rdaym_ini
     130! jD_cur: jour julien courant
     131! jH_cur: heure julienne courante
     132      REAL :: jD_cur, jH_cur
     133      INTEGER :: an, mois, jour
     134      REAL :: secondes
     135
    127136      LOGICAL first,callinigrads
    128137cIM : pour sortir les param. du modele dans un fis. netcdf 110106
    129138      save first
    130139      data first/.true./
    131       real dt_cum, zjulian
     140      real dt_cum
    132141      character*10 infile
    133142      integer zan, tau0, thoriid
    … …  
    166175      character*80 abort_message
    167176
    168 C Calendrier
    169       LOGICAL true_calendar
    170       PARAMETER (true_calendar = .false.)
    171 
    172177      logical dissip_conservative
    173178      save dissip_conservative
    … …  
    192197
    193198      itau = 0
    194       iday = day_ini+itau/day_step
    195       time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
    196          IF(time.GT.1.) THEN
    197           time = time-1.
    198           iday = iday+1
    199          ENDIF
     199c$$$      iday = day_ini+itau/day_step
     200c$$$      time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
     201c$$$         IF(time.GT.1.) THEN
     202c$$$          time = time-1.
     203c$$$          iday = iday+1
     204c$$$         ENDIF
    200205
    201206
    … …  
    214219   1  CONTINUE
    215220
     221      jD_cur = jD_ref + day_ini - day_ref + int (itau * dtvr / daysec)
     222      jH_cur = jH_ref +                                                 &
     223     &          (itau * dtvr / daysec - int(itau * dtvr / daysec))
     224
    216225
    217226#ifdef CPP_IOIPSL
    218       if (ok_guide.and.(itaufin-itau-1)*dtvr.gt.21600) then
    219         call guide(itau,ucov,vcov,teta,q,masse,ps)
    220       else
    221         IF(prt_level>9)WRITE(lunout,*)'leapfrog: attention on ne ',
    222      .    'guide pas les 6 dernieres heures'
     227      if (ok_guide) then
     228        call guide_main(itau,ucov,vcov,teta,q,masse,ps)
    223229      endif
    224230#endif
     231
     232
    225233c
    226234c     IF( MOD( itau, 10* day_step ).EQ.0 )  THEN
    … …  
    284292      CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
    285293
     294      time = jD_cur + jH_cur
    286295      CALL caldyn
    287296     $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
    288      $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time+iday-day_ini )
     297     $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time )
     298
    289299
    290300c-----------------------------------------------------------------------
    … …  
    344354         CALL exner_hyb(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
    345355
    346            rdaym_ini  = itau * dtvr / daysec
    347            rdayvrai   = rdaym_ini  + day_ini
    348 
     356!           rdaym_ini  = itau * dtvr / daysec
     357!           rdayvrai   = rdaym_ini  + day_ini
     358           jD_cur = jD_ref + day_ini - day_ref
     359     $        + int (itau * dtvr / daysec)
     360           jH_cur = jH_ref +                                            &
     361     &              (itau * dtvr / daysec - int(itau * dtvr / daysec))
     362!         write(lunout,*)'itau, jD_cur = ', itau, jD_cur, jH_cur
     363!         call ju2ymds(jD_cur+jH_cur, an, mois, jour, secondes)
     364!         write(lunout,*)'current date = ',an, mois, jour, secondes
    349365
    350366c rajout debug
    … …  
    378394#endif
    379395! #endif of #ifdef CPP_IOIPSL
    380          CALL calfis( lafin ,rdayvrai,time  ,
     396         CALL calfis( lafin , jD_cur, jH_cur,
    381397     $               ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
    382398     $               du,dv,dteta,dq,
    … …  
    385401
    386402         IF (ok_strato) THEN
    387            CALL top_bound( vcov,ucov,teta, dufi,dvfi,dtetafi)
     403           CALL top_bound( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
    388404         ENDIF
    389405       
    … …  
    506522            IF(forward. OR. leapf) THEN
    507523              itau= itau + 1
    508               iday= day_ini+itau/day_step
    509               time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
    510                 IF(time.GT.1.) THEN
    511                   time = time-1.
    512                   iday = iday+1
    513                 ENDIF
     524c$$$              iday= day_ini+itau/day_step
     525c$$$              time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
     526c$$$                IF(time.GT.1.) THEN
     527c$$$                  time = time-1.
     528c$$$                  iday = iday+1
     529c$$$                ENDIF
    514530            ENDIF
    515531
    … …  
    517533            IF( itau. EQ. itaufinp1 ) then 
    518534              if (flag_verif) then
    519                 write(80,*) 'ucov',ucov
    520                 write(81,*) 'vcov',vcov
    521                 write(82,*) 'teta',teta
    522                 write(83,*) 'ps',ps
    523                 write(84,*) 'q',q
     535                write(79,*) 'ucov',ucov
     536                write(80,*) 'vcov',vcov
     537                write(81,*) 'teta',teta
     538                write(82,*) 'ps',ps
     539                write(83,*) 'q',q
    524540                WRITE(85,*) 'q1 = ',q(:,:,1)
    525541                WRITE(86,*) 'q3 = ',q(:,:,3)
    526                 write(90) ucov
    527                 write(91) vcov
    528                 write(92) teta
    529                 write(93) ps
    530                 write(94) q
    531542              endif
    532543
    … …  
    548559               IF (ok_dynzon) THEN
    549560#ifdef CPP_IOIPSL
    550                   CALL writedynav(histaveid, itau,vcov ,
    551      ,                 ucov,teta,pk,phi,q,masse,ps,phis)
     561!                  CALL writedynav(histaveid, itau,vcov ,
     562!     ,                 ucov,teta,pk,phi,q,masse,ps,phis)
    552563                  CALL bilan_dyn (2,dtvr*iperiod,dtvr*day_step*periodav,
    553564     ,                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
    … …  
    586597
    587598              if (planet_type.eq."earth") then
    588 #ifdef CPP_EARTH
    589599! Write an Earth-format restart file
    590600                CALL dynredem1("restart.nc",0.0,
    591601     &                         vcov,ucov,teta,q,masse,ps)
    592 #endif
    593602              endif ! of if (planet_type.eq."earth")
    594603
    … …  
    636645
    637646             itau =  itau + 1
    638              iday = day_ini+itau/day_step
    639              time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
    640 
    641                   IF(time.GT.1.) THEN
    642                    time = time-1.
    643                    iday = iday+1
    644                   ENDIF
     647c$$$             iday = day_ini+itau/day_step
     648c$$$             time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
     649c$$$
     650c$$$                  IF(time.GT.1.) THEN
     651c$$$                   time = time-1.
     652c$$$                   iday = iday+1
     653c$$$                  ENDIF
    645654
    646655               forward =  .FALSE.
    … …  
    662671               IF (ok_dynzon) THEN
    663672#ifdef CPP_IOIPSL
    664                   CALL writedynav(histaveid, itau,vcov ,
    665      ,                 ucov,teta,pk,phi,q,masse,ps,phis)
     673!                  CALL writedynav(histaveid, itau,vcov ,
     674!     ,                 ucov,teta,pk,phi,q,masse,ps,phis)
    666675                  CALL bilan_dyn (2,dtvr*iperiod,dtvr*day_step*periodav,
    667676     ,                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
    … …  
    693702              IF(itau.EQ.itaufin) THEN
    694703                if (planet_type.eq."earth") then
    695 #ifdef CPP_EARTH
    696704                  CALL dynredem1("restart.nc",0.0,
    697705     &                           vcov,ucov,teta,q,masse,ps)
    698 #endif
    699706                endif ! of if (planet_type.eq."earth")
    700707              ENDIF ! of IF(itau.EQ.itaufin)

  • LMDZ4/trunk/libf/dyn3d/limit_netcdf.F

    r997 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44C
    55C
    66      SUBROUTINE limit_netcdf(interbar, extrap, oldice, masque)
     7#ifdef CPP_EARTH
     8! This routine is designed to work for Earth
    79      USE dimphy
    810      use phys_state_var_mod , ONLY : pctsrf
    … …  
    3335cy#include "dimphy.h"
    3436#include "indicesol.h"
     37#include "iniprint.h"
    3538c
    3639c-----------------------------------------------------------------------
    … …  
    403406      ENDDO
    404407
    405       PRINT 222, timeyear
     408      PRINT 222, timeyear(:lmdep)
    406409222   FORMAT(2x,' Time year ',10f6.1)
    407410c
    … …  
    620623         timeyear(l) = tmidmonth(l)
    621624      ENDDO
    622       PRINT 222,  timeyear
     625      PRINT 222,  timeyear(:lmdep)
    623626c
    624627      PRINT*, 'Interpolation temporelle'
    … …  
    939942         timeyear(l) = tmidmonth(l)
    940943      ENDDO
    941       print 222,  timeyear
     944      print 222,  timeyear(:lmdep)
    942945c
    943946C interpolation temporelle
    … …  
    11341137         timeyear(l) = timecoord(l)
    11351138      ENDDO
    1136       print 222,  timeyear
     1139      print 222,  timeyear(:lmdep)
    11371140c
    11381141C interpolation temporelle
    … …  
    13231326      ierr = NF_CLOSE(nid)
    13241327c
     1328#else
     1329      WRITE(lunout,*)
     1330     & 'limit_netcdf: Earth-specific routine, needs Earth physics'
     1331#endif
     1332! of #ifdef CPP_EARTH
    13251333      STOP
    13261334      END

  • LMDZ4/trunk/libf/dyn3d/pres2lev.F

    r1046 r1279  
    1 !
    2 ! $Header$
     1! $Id$
    32!
    43c******************************************************
    … …  
    2120c  ARGUMENTS
    2221c  """""""""
    23        LOGICAL ok_invertp
    24        INTEGER lmo ! dimensions ancienne couches (input)
    25        INTEGER lmn ! dimensions nouvelle couches (input)
    26        INTEGER lmomx ! dimensions ancienne couches (input)
    27        INTEGER lmnmx ! dimensions nouvelle couches (input)
     22       LOGICAL, INTENT(IN) :: ok_invertp
     23       INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
     24       INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
     25       INTEGER lmomx ! dimensions ancienne couches
     26       INTEGER lmnmx ! dimensions nouvelle couches
    2827
    2928       parameter(lmomx=10000,lmnmx=10000)
    3029
    31         real po(ni,nj,lmo)! niveau de pression ancienne grille
    32         real pn(ni,nj,lmn) ! niveau de pression nouvelle grille
     30        real, INTENT(IN) :: po(ni,nj,lmo) ! niveau de pression ancienne grille
     31        real, INTENT(IN) :: pn(ni,nj,lmn) ! niveau de pression nouvelle grille
    3332
    34        INTEGER i,j,Nhoriz,ni,nj ! nombre de point horizontale (input)
     33       INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontale
    3534
    36        REAL varo(ni,nj,lmo) ! var dans l'ancienne grille (input)
    37        REAL varn(ni,nj,lmn) ! var dans la nouvelle grille (output)
     35       REAL, INTENT(IN)  :: varo(ni,nj,lmo) ! var dans l'ancienne grille
     36       REAL, INTENT(OUT) :: varn(ni,nj,lmn) ! var dans la nouvelle grille
    3837
    3938       real zvaro(lmomx),zpo(lmomx)
    … …  
    4140c Autres variables
    4241c """"""""""""""""
    43        INTEGER n, ln ,lo 
     42       INTEGER n, ln ,lo, i, j, Nhoriz
    4443       REAL coef
    4544

  • LMDZ4/trunk/libf/dyn3d/sortvarc.F

    r524 r1279  
    129129      ang   = SSUM(     llm,  angl, 1 )
    130130
    131       rday = FLOAT(INT ( day_ini + time ))
     131c      rday = FLOAT(INT ( day_ini + time ))
    132132c
     133       rday = FLOAT(INT(time-jD_ref-jH_ref))
    133134      IF(ptot0.eq.0.)  THEN
    134135         PRINT 3500, itau, rday, heure,time
    … …  
    156157      RETURN
    157158
    158 3500   FORMAT('0'10(1h*),4x,'pas'i7,5x,'jour'f5.0,'heure'f5.1,4x
    159      *   ,'date',f10.5,4x,10(1h*))
     1593500   FORMAT(10("*"),4x,'pas',i7,5x,'jour',f9.0,'heure',f5.1,4x
     160     *   ,'date',f14.4,4x,10("*"))
    1601614000   FORMAT(10x,'masse',4x,'rmsdpdt',7x,'energie',2x,'enstrophie'
    161162     * ,2x,'entropie',3x,'rmsv',4x,'mt.ang',/,'GLOB  '

  • LMDZ4/trunk/libf/dyn3d/sortvarc0.F

    r524 r1279  
    130130      ang0   = SSUM(     llm,  angl, 1 )
    131131
    132       rday = FLOAT(INT ( day_ini + time ))
     132      rday = FLOAT(INT (time ))
    133133c
    134134      PRINT 3500, itau, rday, heure, time
    135135      PRINT *, ptot0,etot0,ztot0,stot0,ang0
    136136
    137 3500   FORMAT('0',10(1h*),4x,'pas',i7,5x,'jour',f5.0,'heure',f5.1,4x
    138      *   ,'date',f10.5,4x,10(1h*))
     1373500   FORMAT(10("*"),4x,'pas',i7,5x,'jour',f5.0,'heure',f5.1,4x
     138     *   ,'date',f10.5,4x,10("*"))
    139139      RETURN
    140140      END

  • LMDZ4/trunk/libf/dyn3d/startvar.F

    r677 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    4 C
    5 C
    64      MODULE startvar
     5#ifdef CPP_EARTH
     6! This module is designed to work for Earth (and with ioipsl)
    77    !
    88    !
    … …  
    11891189      END SUBROUTINE start_inter_3d
    11901190    !
     1191#endif
     1192! of #ifdef CPP_EARTH
    11911193      END MODULE startvar

  • LMDZ4/trunk/libf/dyn3d/temps.h

    r792 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
    … …  
    88!
    99!
     10! jD_ref = jour julien de la date de reference (lancement de l'experience)
     11! hD_ref = "heure" julienne de la date de reference
    1012!-----------------------------------------------------------------------
    1113! INCLUDE 'temps.h'
    1214
    1315      COMMON/temps/itaufin, dt, day_ini, day_end, annee_ref, day_ref,   &
    14      &             itau_dyn, itau_phy
     16     &             itau_dyn, itau_phy, jD_ref, jH_ref, calend
    1517
    1618      INTEGER   itaufin
    17       INTEGER*4 itau_dyn, itau_phy
    18       INTEGER*4 day_ini, day_end, annee_ref, day_ref
    19       REAL      dt
     19      INTEGER itau_dyn, itau_phy
     20      INTEGER day_ini, day_end, annee_ref, day_ref
     21      REAL      dt, jD_ref, jH_ref
     22      CHARACTER (len=10) :: calend
    2023
    2124!-----------------------------------------------------------------------

  • LMDZ4/trunk/libf/dyn3d/top_bound.F

    r999 r1279  
    1       SUBROUTINE top_bound( vcov,ucov,teta, du,dv,dh )
     1      SUBROUTINE top_bound( vcov,ucov,teta,masse, du,dv,dh )
    22      IMPLICIT NONE
    33c
    … …  
    55#include "paramet.h"
    66#include "comconst.h"
    7 CC#include "comgeom2.h"
     7#include "comvert.h"
     8#include "comgeom2.h"
    89
    910
    … …  
    2728c   -------------
    2829
    29 #include "comgeom.h"
     30! #include "comgeom.h"
    3031#include "comdissipn.h"
    3132
    … …  
    3435
    3536      REAL ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm),teta(iip1,jjp1,llm)
     37      REAL masse(iip1,jjp1,llm)
    3638      REAL dv(iip1,jjm,llm),du(iip1,jjp1,llm),dh(iip1,jjp1,llm)
    3739
    … …  
    3941c   ------
    4042
     43      REAL massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm),zm
    4144      REAL uzon(jjp1,llm),vzon(jjm,llm),tzon(jjp1,llm)
    4245     
    4346      INTEGER NDAMP
    4447      PARAMETER (NDAMP=4)
    45       integer i
    46       REAL :: rdamp(llm) =
    47      &   (/(0., i =1,llm-NDAMP),0.125E-5,.25E-5,.5E-5,1.E-5/)
     48      integer i
     49      REAL,SAVE :: rdamp(llm)
     50!     &   (/(0., i =1,llm-NDAMP),0.125E-5,.25E-5,.5E-5,1.E-5/)
     51
     52      LOGICAL,SAVE :: first=.true.
    4853
    4954      INTEGER j,l
    … …  
    5257C  CALCUL DES CHAMPS EN MOYENNE ZONALE:
    5358     
     59      if (iflag_top_bound.eq.0) return
     60
     61      if (first) then
     62         if (iflag_top_bound.eq.1) then
     63! couche eponge dans les 4 dernieres couches du modele
     64             rdamp(:)=0.
     65             rdamp(llm)=tau_top_bound
     66             rdamp(llm-1)=tau_top_bound/2.
     67             rdamp(llm-2)=tau_top_bound/4.
     68             rdamp(llm-3)=tau_top_bound/8.
     69         else if (iflag_top_bound.eq.2) then
     70! couce eponge dans toutes les couches de pression plus faible que
     71! 100 fois la pression de la derniere couche
     72             rdamp(:)=tau_top_bound
     73     s       *max(presnivs(llm)/presnivs(:)-0.01,0.)
     74         endif
     75         first=.false.
     76         print*,'TOP_BOUND rdamp=',rdamp
     77      endif
     78
     79      CALL massbar(masse,massebx,masseby)
     80
    5481      do l=1,llm
    5582        do j=1,jjm
    5683          vzon(j,l)=0.
     84          zm=0.
    5785          do i=1,iim
    58             vzon(j,l)=vzon(j,l)+vcov(i,j,l)/float(iim)
     86! Rm: on peut travailler directement avec la moyenne zonale de vcov
     87! plutot qu'avec celle de v car le coefficient cv qui relie les deux
     88! ne varie qu'en latitude
     89            vzon(j,l)=vzon(j,l)+vcov(i,j,l)*masseby(i,j,l)
     90            zm=zm+masseby(i,j,l)
    5991          enddo
     92          vzon(j,l)=vzon(j,l)/zm
    6093        enddo
    6194      enddo
    … …  
    72105        do j=2,jjm
    73106          uzon(j,l)=0.
     107          zm=0.
     108          do i=1,iim
     109            uzon(j,l)=uzon(j,l)+massebx(i,j,l)*ucov(i,j,l)/cu(i,j)
     110            zm=zm+massebx(i,j,l)
     111          enddo
     112          uzon(j,l)=uzon(j,l)/zm
     113        enddo
     114      enddo
     115
     116      do l=1,llm
     117        do j=2,jjm
     118          zm=0.
    74119          tzon(j,l)=0.
    75120          do i=1,iim
    76             uzon(j,l)=uzon(j,l)+ucov(i,j,l)/float(iim)
    77             tzon(j,l)=tzon(j,l)+teta(i,j,l)/float(iim)
     121            tzon(j,l)=tzon(j,l)+teta(i,j,l)*masse(i,j,l)
     122            zm=zm+masse(i,j,l)
    78123          enddo
     124          tzon(j,l)=tzon(j,l)/zm
    79125        enddo
    80126      enddo
    … …  
    85131        do i=1,iip1
    86132          do j=2,jjm
    87             du(i,j,l)=du(i,j,l)-rdamp(l)*(ucov(i,j,l)-uzon(j,l))
     133            du(i,j,l)=du(i,j,l)
     134     s               -rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l))
    88135            dh(i,j,l)=dh(i,j,l)-rdamp(l)*(teta(i,j,l)-tzon(j,l))
    89136          enddo

  • LMDZ4/trunk/libf/dyn3d/ugeostr.F

    r524 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      subroutine ugeostr(phi,ucov)
    … …  
    2020
    2121      real zlat
     22
     23      um(:,:)=0 ! initialize um()
    2224
    2325      DO j=1,jjm
    … …  
    4244         ENDDO
    4345      ENDDO
    44       call dump2d(jjp1,llm,um,'Vent-u geostrophique')
     46      call dump2d(jjm,llm,um,'Vent-u geostrophique')
    4547
    4648c

  • LMDZ4/trunk/libf/dyn3d/write_paramLMDZ_dyn.h

    r956 r1279  
    107107     .               zx_tmp_2d,iip1*jjp1,ndex2d)
    108108c
    109       IF(true_calendar) THEN
    110        zx_tmp_2d(1:iip1,1:jjp1)=1.
    111       ELSE
    112        zx_tmp_2d(1:iip1,1:jjp1)=0.
    113       ENDIF
     109      if (calend == 'earth_360d') then
     110        zx_tmp_2d(1:iip1,1:jjp1)=1.
     111      else if (calend == 'earth_365d') then
     112        zx_tmp_2d(1:iip1,1:jjp1)=2.
     113      else if (calend == 'earth_366d') then
     114        zx_tmp_2d(1:iip1,1:jjp1)=3.
     115      endif
     116
    114117      CALL histwrite(nid_ctesGCM, "true_calendar", itau_w,
    115118     .               zx_tmp_2d,iip1*jjp1,ndex2d)
Note: See TracChangeset for help on using the changeset viewer.