Changeset 1279 for LMDZ4/trunk/libf


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:
24 deleted
141 edited
95 copied

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk

  • LMDZ4/trunk/libf/bibio/initdynav.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    4 c
    5 c
    64      subroutine initdynav(infile,day0,anne0,tstep,t_ops,t_wrt
    75     .                     ,fileid)
    86
     7#ifdef CPP_IOIPSL
    98       USE IOIPSL
     9#endif
    1010       USE infotrac, ONLY : nqtot, ttext
    1111
    … …  
    4848#include "description.h"
    4949#include "serre.h"
     50#include "iniprint.h"
    5051
    5152C   Arguments
    5253C
    5354      character*(*) infile
    54       integer*4 day0, anne0
     55      integer day0, anne0
    5556      real tstep, t_ops, t_wrt
    5657      integer fileid
    57       integer thoriid, zvertiid
    5858
     59#ifdef CPP_IOIPSL
     60! This routine needs IOIPSL to work
    5961C   Variables locales
    6062C
     63      integer thoriid, zvertiid
    6164      integer tau0
    6265      real zjulian
    … …  
    161164C
    162165      call histend(fileid)
     166#else
     167! tell the user this routine should be run with ioipsl
     168      write(lunout,*)"initdynav: Warning this routine should not be",
     169     &               " used without ioipsl"
     170#endif
     171! of #ifdef CPP_IOIPSL
    163172      return
    164173      end

  • LMDZ4/trunk/libf/bibio/initfluxsto.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      subroutine initfluxsto
    … …  
    66     .                    fileid,filevid,filedid)
    77
     8#ifdef CPP_IOIPSL
    89       USE IOIPSL
    9 
     10#endif
    1011      implicit none
    1112
    … …  
    4748#include "description.h"
    4849#include "serre.h"
     50#include "iniprint.h"
    4951
    5052C   Arguments
    5153C
    5254      character*(*) infile
    53       integer*4 itau
    5455      real tstep, t_ops, t_wrt
    5556      integer fileid, filevid,filedid
    56       integer ndex(1)
     57
     58#ifdef CPP_IOIPSL
     59! This routine needs IOIPSL to work
     60C   Variables locales
     61C
    5762      real nivd(1)
    58 
    59 C   Variables locales
    60 C
    6163      integer tau0
    6264      real zjulian
    … …  
    222224      endif
    223225       
     226#else
     227! tell the user this routine should be run with ioipsl
     228      write(lunout,*)"initfluxsto: Warning this routine should not be",
     229     &               " used without ioipsl"
     230#endif
     231! of #ifdef CPP_IOIPSL
    224232      return
    225233      end

  • LMDZ4/trunk/libf/bibio/inithist.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      subroutine inithist(infile,day0,anne0,tstep,t_ops,t_wrt,fileid,
    55     .                    filevid)
    66
     7#ifdef CPP_IOIPSL
    78       USE IOIPSL
     9#endif
    810       USE infotrac, ONLY : nqtot, ttext
    911
    … …  
    4850#include "description.h"
    4951#include "serre.h"
     52#include "iniprint.h"
    5053
    5154C   Arguments
    5255C
    5356      character*(*) infile
    54       integer*4 day0, anne0
     57      integer day0, anne0
    5558      real tstep, t_ops, t_wrt
    5659      integer fileid, filevid
    5760
     61#ifdef CPP_IOIPSL
     62! This routine needs IOIPSL to work
    5863C   Variables locales
    5964C
    … …  
    181186      call histend(fileid)
    182187      call histend(filevid)
     188#else
     189! tell the user this routine should be run with ioipsl
     190      write(lunout,*)"inithist: Warning this routine should not be",
     191     &               " used without ioipsl"
     192#endif
     193! of #ifdef CPP_IOIPSL
    183194      return
    184195      end

  • LMDZ4/trunk/libf/bibio/write_field.F90

    r772 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44module write_field
    … …  
    7272       
    7373    subroutine WriteField_gen(name,Field,dimx,dimy,dimz)
    74     USE ioipsl
    7574    implicit none
    7675    include 'netcdf.inc'
    … …  
    109108       
    110109    subroutine CreateNewField(name,dimx,dimy,dimz)
    111     USE ioipsl
    112110    implicit none
    113111    include 'netcdf.inc' 
    … …  
    229227        write (id,spacing)
    230228      else
    231         write (id,'')
     229        write (id,'("")')
    232230        write (id,spacing)
    233231      endif

  • LMDZ4/trunk/libf/bibio/writedynav.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      subroutine writedynav( histid, time, vcov,
    55     ,                          ucov,teta,ppk,phi,q,masse,ps,phis)
    66
     7#ifdef CPP_IOIPSL
    78      USE ioipsl
     9#endif
    810      USE infotrac, ONLY : nqtot, ttext
    911      implicit none
    … …  
    4547#include "description.h"
    4648#include "serre.h"
     49#include "iniprint.h"
    4750
    4851C
    … …  
    5962
    6063
     64#ifdef CPP_IOIPSL
     65! This routine needs IOIPSL to work
    6166C   Variables locales
    6267C
    … …  
    138143C
    139144      if (ok_sync) call histsync(histid)
     145
     146#else
     147! tell the user this routine should be run with ioipsl
     148      write(lunout,*)"writedynav: Warning this routine should not be",
     149     &               " used without ioipsl"
     150#endif
     151! of #ifdef CPP_IOIPSL
    140152      return
    141153      end

  • LMDZ4/trunk/libf/bibio/writehist.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      subroutine writehist( histid, histvid, time, vcov,
    55     ,                          ucov,teta,phi,q,masse,ps,phis)
    66
     7#ifdef CPP_IOIPSL
    78      USE ioipsl
     9#endif
    810      USE infotrac, ONLY : nqtot, ttext
    911      implicit none
    … …  
    4648#include "description.h"
    4749#include "serre.h"
     50#include "iniprint.h"
    4851
    4952C
    … …  
    6063
    6164
     65#ifdef CPP_IOIPSL
     66! This routine needs IOIPSL to work
    6267C   Variables locales
    6368C
    … …  
    124129        call histsync(histvid)
    125130      endif
     131#else
     132! tell the user this routine should be run with ioipsl
     133      write(lunout,*)"writehist: Warning this routine should not be",
     134     &               " used without ioipsl"
     135#endif
     136! of #ifdef CPP_IOIPSL
    126137      return
    127138      end

  • 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)

  • LMDZ4/trunk/libf/dyn3dpar/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
     14      USE parallel
    1115#include "iniprint.h"
    1216 
    … …  
    2832      call histclo
    2933      call restclo
     34      if (MPI_rank .eq. 0) then
     35         call getin_dump
     36      endif
    3037c$OMP END MASTER
    3138#endif
    32       call getin_dump
    3339c     call histclo(2)
    3440c     call histclo(3)

  • LMDZ4/trunk/libf/dyn3dpar/bands.F90

    r792 r1279  
     1!
     2! $Id$
     3!
    14  module Bands
    25 
    … …  
    9093   SUBROUTINE  Set_Bands
    9194     USE parallel
     95#ifdef CPP_EARTH
     96! Ehouarn: what follows is only related to // physics; for now only for Earth
    9297     USE mod_phys_lmdz_para, ONLY : jj_para_begin,jj_para_end
     98#endif
    9399     IMPLICIT NONE
    94100     INCLUDE 'dimensions.h'   
    … …  
    100106      enddo
    101107         
     108#ifdef CPP_EARTH
     109! Ehouarn: what follows is only related to // physics; for now only for Earth         
    102110      do i=0,MPI_Size-1
    103111        jj_Nb_physic(i)=jj_para_end(i)-jj_para_begin(i)+1
    … …  
    120128        endif
    121129      enddo
     130#endif     
    122131     
    123132    end subroutine Set_Bands
    … …  
    323332    subroutine AdjustBands_physic
    324333      use times
     334#ifdef CPP_EARTH
     335! Ehouarn: what follows is only related to // physics; for now only for Earth
    325336      USE mod_phys_lmdz_para, only : klon_mpi_para_nb
     337#endif
    326338      USE parallel
    327339      implicit none
    … …  
    347359      medium=medium/mpi_size     
    348360      NbTot=0
     361#ifdef CPP_EARTH
     362! Ehouarn: what follows is only related to // physics; for now only for Earth
    349363      do i=0,mpi_size-1
    350364        Inc(i)=nint(klon_mpi_para_nb(i)*(medium-value(i))/value(i))
    … …  
    369383        distrib_phys(i)=klon_mpi_para_nb(i)+inc(i)
    370384      enddo
    371      
     385#endif     
    372386    end subroutine AdjustBands_physic
    373387

  • LMDZ4/trunk/libf/dyn3dpar/bilan_dyn_p.F

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

  • LMDZ4/trunk/libf/dyn3dpar/caladvtrac_p.F

    r1146 r1279  
    8282          ENDDO
    8383
    84           CALL qminimum_p( q, 2, finmasse )
     84          if (planet_type.eq."earth") then
     85! Earth-specific treatment of first 2 tracers (water)
     86            CALL qminimum_p( q, 2, finmasse )
     87          endif
     88
    8589
    8690cym   --> le reste ne set a rien

  • LMDZ4/trunk/libf/dyn3dpar/calfis_p.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44C
    55C
    66      SUBROUTINE calfis_p(lafin,
    7      $                  rdayvrai,
    8      $                  heure,
     7     $                  jD_cur, jH_cur,
    98     $                  pucov,
    109     $                  pvcov,
    … …  
    2827     $                  pdqfi,
    2928     $                  pdpsfi)
     29#ifdef CPP_EARTH
     30! Ehouarn: For now, calfis_p needs Earth physics
    3031c
    3132c    Auteur :  P. Le Van, F. Hourdin
    … …  
    157158      REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:)
    158159c
    159 c      REAL,ALLOCATABLE,SAVE :: pvervel(:,:)
    160 c
    161160      REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:)
    162161      REAL,ALLOCATABLE,SAVE :: zdtfi(:,:),zdqfi(:,:,:)
    … …  
    174173      REAL,ALLOCATABLE,SAVE :: ztfi_omp(:,:)
    175174      REAL,ALLOCATABLE,SAVE :: zqfi_omp(:,:,:)
    176 c      REAL,ALLOCATABLE,SAVE :: pvervel_omp(:,:)
    177175      REAL,ALLOCATABLE,SAVE :: zdufi_omp(:,:)
    178176      REAL,ALLOCATABLE,SAVE :: zdvfi_omp(:,:)
    … …  
    209207      SAVE firstcal,debut
    210208c$OMP THREADPRIVATE(firstcal,debut)
    211       REAL rdayvrai
     209      REAL, intent(in):: jD_cur, jH_cur
    212210     
    213211      REAL,SAVE,dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv
    … …  
    233231      PVteta(:,:)=0.
    234232           
    235       IF (ngridmx.NE.2+(jjm-1)*iim) THEN
     233c
     234      IF ( firstcal )  THEN
     235        debut = .TRUE.
     236        IF (ngridmx.NE.2+(jjm-1)*iim) THEN
    236237         PRINT*,'STOP dans calfis'
    237238         PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
    … …  
    239240         PRINT*,ngridmx,jjm,iim
    240241         STOP
    241       ENDIF
    242 
    243 c-----------------------------------------------------------------------
    244 c   latitude, longitude et aires des mailles pour la physique:
    245 c   ----------------------------------------------------------
    246 
    247 c
    248       IF ( firstcal )  THEN
    249           debut = .TRUE.
     242        ENDIF
    250243c$OMP MASTER
    251244      ALLOCATE(zpsrf(klon))
    … …  
    256249      ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm))
    257250      ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2))
    258 c      ALLOCATE(pvervel(klon,llm))
    259251      ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm))
    260252      ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqtot))
    … …  
    282274
    283275c$OMP MASTER             
     276!CDIR ON_ADB(index_i)
     277!CDIR ON_ADB(index_j)
    284278      do ig0=1,klon
    285279        i=index_i(ig0)
    … …  
    304298c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    305299      DO l = 1, llmp1
     300!CDIR ON_ADB(index_i)
     301!CDIR ON_ADB(index_j)
    306302        do ig0=1,klon
    307303          i=index_i(ig0)
    … …  
    318314c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    319315      DO l=1,llm
    320 
     316!CDIR ON_ADB(index_i)
     317!CDIR ON_ADB(index_j)
    321318        do ig0=1,klon
    322319          i=index_i(ig0)
    … …  
    325322          zplay(ig0,l)   = preff * pksurcp ** unskap
    326323          ztfi(ig0,l)    = pteta(i,j,l)  * pksurcp
    327 c          pcvgt(ig0,l)   = pdteta(i,j,l) * pksurcp / pmasse(i,j,l)
    328324        enddo
    329325
    … …  
    339335c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    340336         DO l=1,llm
     337!CDIR ON_ADB(index_i)
     338!CDIR ON_ADB(index_j)
    341339           do ig0=1,klon
    342340             i=index_i(ig0)
    … …  
    348346      ENDDO
    349347
    350 c   convergence dynamique pour les traceurs "EAU"
    351 
    352       DO iq=1,2
    353 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    354          DO l=1,llm
    355            do ig0=1,klon
    356              i=index_i(ig0)
    357              j=index_j(ig0)
    358 c             pcvgq(ig0,l,iq) = pdq(i,j,l,iq) / pmasse(i,j,l)
    359            enddo
    360          ENDDO
    361 c$OMP END DO NOWAIT     
    362       ENDDO
    363 
    364 
    365348
    366349c   Geopotentiel calcule par rapport a la surface locale:
    … …  
    381364c$OMP END DO NOWAIT
    382365     
    383 c   ....  Calcul de la vitesse  verticale  ( en Pa*m*s  ou Kg/s )  ....
    384 c JG : ancien calcule de omega utilise dans physiq.F. Maintenant le flux
    385 c      de masse est calclue dans advtrac_p.F 
    386 c
    387 cc$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    388 c      DO l=1,llm
    389 c        do ig0=1,klon
    390 c           i=index_i(ig0)
    391 c           j=index_j(ig0)
    392 c           pvervel(ig0,l) = pw(i,j,l)*g* unsaire(i,j)
    393 c        enddo
    394 c       if (is_north_pole) pvervel(1,l)=pw(1,1,l)*g /apoln
    395 c       if (is_south_pole) pvervel(klon,l)=pw(1,jjp1,l)*g/apols
    396 c      ENDDO
    397 cc$OMP END DO NOWAIT
    398366
    399367c
    … …  
    409377c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    410378      DO l=1,llm
     379!CDIR ON_ADB(index_i)
     380!CDIR ON_ADB(index_j)
     381!CDIR SPARSE
    411382        do ig0=kstart,kend
    412383          i=index_i(ig0)
    … …  
    415386            zufi(ig0,l)= 0.5 *(  pucov(iim,j,l)/cu(iim,j)
    416387     $                         + pucov(1,j,l)/cu(1,j) )
    417 c            pcvgu(ig0,l)= 0.5*(  pducov(iim,j,l)/cu(iim,j)
    418 c     $                         + pducov(1,j,l)/cu(1,j) )
    419388          else
    420389            zufi(ig0,l)= 0.5*(  pucov(i-1,j,l)/cu(i-1,j)
    421390     $                       + pucov(i,j,l)/cu(i,j) )
    422 c            pcvgu(ig0,l)= 0.5*(  pducov(i-1,j,l)/cu(i-1,j)
    423 c     $                        + pducov(i,j,l)/cu(i,j) )
    424391          endif
    425392        enddo
    426393      ENDDO
    427394c$OMP END DO NOWAIT
     395
    428396c   46.champ v:
    429397c   -----------
     398
    430399c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    431400      DO l=1,llm
     401!CDIR ON_ADB(index_i)
     402!CDIR ON_ADB(index_j)
    432403        DO ig0=kstart,kend
    433404          i=index_i(ig0)
    … …  
    436407     $                       + pvcov(i,j,l)/cv(i,j) )
    437408   
    438 c          pcvgv(ig0+i,l)= 0.5 * (  pdvcov(i,j-1,l)/cv(i,j-1)
    439 c     $                           + pdvcov(i,j,l)/cv(i,j) )
    440409         ENDDO
    441410      ENDDO
    … …  
    452421
    453422           z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1)
    454 c           z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,1,l)/cv(1,1)
    455423           DO i=2,iim
    456424              z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
    457 c              z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv(i,1)
    458425           ENDDO
    459426 
    460427           DO i=1,iim
    461428              zcos(i)   = COS(rlonv(i))*z1(i)
    462 c              zcosbis(i)= COS(rlonv(i))*z1bis(i)
    463429              zsin(i)   = SIN(rlonv(i))*z1(i)
    464 c              zsinbis(i)= SIN(rlonv(i))*z1bis(i)
    465430           ENDDO
    466431 
    467432           zufi(1,l)  = SSUM(iim,zcos,1)/pi
    468 c           pcvgu(1,l) = SSUM(iim,zcosbis,1)/pi
    469433           zvfi(1,l)  = SSUM(iim,zsin,1)/pi
    470 c           pcvgv(1,l) = SSUM(iim,zsinbis,1)/pi
    471434 
    472435        ENDDO
    … …  
    485448 
    486449         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm)
    487 c         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,jjm,l)/cv(1,jjm)
    488450           DO i=2,iim
    489            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
    490 c           z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
     451             z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
    491452           ENDDO
    492453 
    493454           DO i=1,iim
    494455              zcos(i)    = COS(rlonv(i))*z1(i)
    495 c              zcosbis(i) = COS(rlonv(i))*z1bis(i)
    496456              zsin(i)    = SIN(rlonv(i))*z1(i)
    497 c              zsinbis(i) = SIN(rlonv(i))*z1bis(i)
    498457           ENDDO
    499458 
    500459           zufi(klon,l)  = SSUM(iim,zcos,1)/pi
    501 c           pcvgu(klon,l) = SSUM(iim,zcosbis,1)/pi
    502460           zvfi(klon,l)  = SSUM(iim,zsin,1)/pi
    503 c           pcvgv(klon,l) = SSUM(iim,zsinbis,1)/pi
    504 
    505461        ENDDO
    506462c$OMP END DO NOWAIT       
    … …  
    524480c   ---------------------
    525481
    526 cc$OMP  PARALLEL DEFAULT(NONE)
    527 cc$OMP+ PRIVATE(i,l,offset,iq)
    528 cc$OMP+ SHARED(klon_omp_nb,nqtot,klon_omp_begin,
    529 cc$OMP+        debut,lafin,rdayvrai,heure,dtphys,zplev,zplay,
    530 cc$OMP+        zphi,zphis,presnivs,clesphy0,zufi,zvfi,ztfi,
    531 cc$OMP+        zqfi,pvervel,zdufi,zdvfi,zdtfi,zdqfi,zdpsrf)
    532 
    533 c PRIVATE(zplev_omp,zplay_omp,zphi_omp,zphis_omp,
    534 c c$OMP+                 presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp,
    535 c c$OMP+                 zqfi_omp,pvervel_omp,zdufi_omp,zdvfi_omp,
    536 c c$OMP+                 zdtfi_omp,zdqfi_omp,zdpsrf_omp)
    537482
    538483c$OMP BARRIER
    … …  
    549494        allocate(ztfi_omp(klon,llm))
    550495        allocate(zqfi_omp(klon,llm,nqtot))
    551 c        allocate(pvervel_omp(klon,llm))
    552496        allocate(zdufi_omp(klon,llm))
    553497        allocate(zdvfi_omp(klon,llm))
    … …  
    616560      enddo
    617561       
    618 c      do l=1,llm
    619 c        do i=1,klon
    620 c         pvervel_omp(i,l)=pvervel(offset+i,l)
    621 c       enddo
    622 c      enddo
    623        
    624562      do l=1,llm
    625563        do i=1,klon
    … …  
    659597     
    660598c$OMP BARRIER
    661 cym      call WriteField_phy_p('zdtfi_omp',zdtfi_omp(:,:),llm)
    662      
     599     
     600      if (planet_type=="earth") then
     601#ifdef CPP_EARTH
    663602      CALL physiq (klon,
    664603     .             llm,
    665604     .             debut,
    666605     .             lafin,
    667      .             rdayvrai,
    668      .             heure,
     606     .             jD_cur,
     607     .             jH_cur,
    669608     .             dtphys,
    670609     .             zplev_omp,
    … …  
    678617     .             ztfi_omp,
    679618     .             zqfi_omp,
    680 c     .             pvervel_omp,
    681619c#ifdef INCA
    682620     .             flxwfi_omp,
    … …  
    690628     .             pducov,
    691629     .             PVteta)
    692 
    693 cym      call WriteField_phy_p('zdtfi_omp',zdtfi_omp(:,:),llm)
    694 
     630#endif
     631      endif !of if (planet_type=="earth")
    695632c$OMP BARRIER
    696633
    … …  
    748685        enddo
    749686      enddo
    750        
    751 c      do l=1,llm
    752 c        do i=1,klon
    753 c         pvervel(offset+i,l)=pvervel_omp(i,l)
    754 c       enddo
    755 c      enddo
    756687       
    757688      do l=1,llm
    … …  
    786717     
    787718
    788 cc$OMP END PARALLEL
    789719      klon=klon_mpi
    790720500   CONTINUE
    … …  
    792722
    793723c$OMP MASTER
    794 cym      call WriteField_phy('zdtfi',zdtfi(:,:),llm)
    795724      call stop_timer(timer_physic)
    796725c$OMP END MASTER
    … …  
    908837      DO l=1,llm
    909838
    910 !!cdir NODEP
     839!CDIR ON_ADB(index_i)
     840!CDIR ON_ADB(index_j)
     841!cdir NODEP
    911842        do ig0=kstart,kend
    912843          i=index_i(ig0)
    … …  
    932863c   62. humidite specifique
    933864c   ---------------------
    934 
    935       DO iq=1,nqtot
    936 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    937          DO l=1,llm
    938 !!cdir NODEP
    939            do ig0=kstart,kend
    940              i=index_i(ig0)
    941              j=index_j(ig0)
    942              pdqfi(i,j,l,iq) = zdqfi(ig0,l,iq)
    943              if (i==1) pdqfi(iip1,j,l,iq) = zdqfi(ig0,l,iq)
    944            enddo
    945            
    946            if (is_north_pole) then
    947              do i=1,iip1
    948                pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)             
    949              enddo
    950            endif
    951            
    952            if (is_south_pole) then
    953              do i=1,iip1
    954                pdqfi(i,jjp1,l,iq) = zdqfi(klon,l,iq)
    955              enddo
    956            endif
    957            
    958          ENDDO
    959 c$OMP END DO NOWAIT
    960       ENDDO
     865! Ehouarn: removed this useless bit: was overwritten at step 63 anyways
     866!      DO iq=1,nqtot
     867!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     868!         DO l=1,llm
     869!!!cdir NODEP
     870!           do ig0=kstart,kend
     871!             i=index_i(ig0)
     872!             j=index_j(ig0)
     873!             pdqfi(i,j,l,iq) = zdqfi(ig0,l,iq)
     874!             if (i==1) pdqfi(iip1,j,l,iq) = zdqfi(ig0,l,iq)
     875!           enddo
     876!           
     877!           if (is_north_pole) then
     878!             do i=1,iip1
     879!               pdqfi(i,1,l,iq)    = zdqfi(1,l,iq)             
     880!             enddo
     881!           endif
     882!           
     883!           if (is_south_pole) then
     884!             do i=1,iip1
     885!               pdqfi(i,jjp1,l,iq) = zdqfi(klon,l,iq)
     886!             enddo
     887!           endif
     888!         ENDDO
     889!c$OMP END DO NOWAIT
     890!      ENDDO
    961891
    962892c   63. traceurs
    … …  
    971901
    972902C
    973 
     903!cdir NODEP
    974904      DO iq=1,nqtot
    975905         iiq=niadv(iq)
    976906c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    977907         DO l=1,llm
    978 
    979 !!cdir NODEP           
     908!CDIR ON_ADB(index_i)
     909!CDIR ON_ADB(index_j)
     910!cdir NODEP           
    980911             DO ig0=kstart,kend
    981912              i=index_i(ig0)
    … …  
    1005936c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1006937      DO l=1,llm
    1007 !!cdir NODEP
     938!CDIR ON_ADB(index_i)
     939!CDIR ON_ADB(index_j)
     940!cdir NODEP
    1008941         do ig0=kstart,kend
    1009942           i=index_i(ig0)
    … …  
    1048981c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    1049982      DO l=1,llm
    1050 !!cdir NODEP
     983!CDIR ON_ADB(index_i)
     984!CDIR ON_ADB(index_j)
     985!cdir NODEP
    1051986        do ig0=kstart,kend
    1052987           i=index_i(ig0)
    … …  
    11111046      firstcal = .FALSE.
    11121047
     1048#else
     1049      write(*,*) "calfis_p: for now can only work with parallel physics"
     1050      stop
     1051#endif
     1052! of #ifdef CPP_EARTH
    11131053      RETURN
    11141054      END

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

    r774 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/dyn3dpar/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/dyn3dpar/comvert.h

    r774 r1279  
    22! $Header$
    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/dyn3dpar/conf_gcm.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44c
    … …  
    4444!#include "clesphys.h"
    4545#include "iniprint.h"
     46#include "temps.h"
     47#include "comconst.h"
    4648
    4749! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
    … …  
    121123      CALL getin('planet_type',planet_type)
    122124
     125!Config  Key  = calend
     126!Config  Desc = type de calendrier utilise
     127!Config  Def  = earth_360d
     128!Config  Help = valeur possible: earth_360d, earth_365d, earth_366d
     129!Config         
     130      calend = 'earth_360d'
     131      CALL getin('calend', calend)
     132
    123133!Config  Key  = dayref
    124134!Config  Desc = Jour de l'etat initial
    … …  
    278288       CALL getin('tetatemp',tetatemp )
    279289
     290! Parametres controlant la variation sur la verticale des constantes de
     291! dissipation.
     292! Pour le moment actifs uniquement dans la version a 39 niveaux
     293! avec ok_strato=y
     294
     295       dissip_factz=4.
     296       dissip_deltaz=10.
     297       dissip_zref=30.
     298       CALL getin('dissip_factz',dissip_factz )
     299       CALL getin('dissip_deltaz',dissip_deltaz )
     300       CALL getin('dissip_zref',dissip_zref )
     301
     302       iflag_top_bound=1
     303       tau_top_bound=1.e-5
     304       CALL getin('iflag_top_bound',iflag_top_bound)
     305       CALL getin('tau_top_bound',tau_top_bound)
     306
     307!
    280308!Config  Key  = coefdis
    281309!Config  Desc = coefficient pour gamdissip
    … …  
    569597      write(lunout,*)' Configuration des parametres du gcm: '
    570598      write(lunout,*)' planet_type = ', planet_type
     599      write(lunout,*)' calend = ', calend
    571600      write(lunout,*)' dayref = ', dayref
    572601      write(lunout,*)' anneeref = ', anneeref
    … …  
    590619      write(lunout,*)' read_start = ', read_start
    591620      write(lunout,*)' iflag_phys = ', iflag_phys
     621      write(lunout,*)' iphysiq = ', iphysiq
    592622      write(lunout,*)' clonn = ', clonn
    593623      write(lunout,*)' clatt = ', clatt
    … …  
    776806!Config  Desc = activation de la version strato
    777807!Config  Def  = .FALSE.
    778 !Config  Help = active la version stratosph�rique de LMDZ de F. Lott
     808!Config  Help = active la version stratosphérique de LMDZ de F. Lott
    779809
    780810      ok_strato=.FALSE.
    … …  
    792822      write(lunout,*)' Configuration des parametres du gcm: '
    793823      write(lunout,*)' planet_type = ', planet_type
     824      write(lunout,*)' calend = ', calend
    794825      write(lunout,*)' dayref = ', dayref
    795826      write(lunout,*)' anneeref = ', anneeref
    … …  
    813844      write(lunout,*)' read_start = ', read_start
    814845      write(lunout,*)' iflag_phys = ', iflag_phys
    815       write(lunout,*)' clon = ', clon
     846      write(lunout,*)' iphysiq = ', iphysiq
     847      write(lunout,*)' clon = ', clon
    816848      write(lunout,*)' clat = ', clat
    817849      write(lunout,*)' grossismx = ', grossismx

  • LMDZ4/trunk/libf/dyn3dpar/cray.F

    r774 r1279  
    1313      real sx((n-1)*incx+1),sy((n-1)*incy+1)
    1414c
     15      if (incx.eq.1.and.incy.eq.1) then
     16      do 10 i=1,n
     17         sy(i)=sx(i)
     1810    continue
     19      else
    1520      iy=1
    1621      ix=1
    17       do 10 i=1,n
     22      do 11 i=1,n
    1823         sy(iy)=sx(ix)
    1924         ix=ix+incx
    2025         iy=iy+incy
    21 10    continue
     2611    continue
     27      endif
    2228c
    2329      return
    … …  
    3238c
    3339      ssum=0.
     40      if (incx.eq.1) then
     41      do 10 i=1,n
     42         ssum=ssum+sx(i)
     4310    continue
     44      else
    3445      ix=1
    35       do 10 i=1,n
     46      do 11 i=1,n
    3647         ssum=ssum+sx(ix)
    3748         ix=ix+incx
    38 10    continue
     4911    continue
     50      endif
    3951c
    4052      return

  • LMDZ4/trunk/libf/dyn3dpar/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 mod_phys_lmdz_para
    810       USE mod_const_mpi
    9        USE phys_state_var_mod     
    1011       USE infotrac
     12#ifdef CPP_IOIPSL
     13       use ioipsl, only: ioconf_calendar
     14#endif
    1115       IMPLICIT NONE
    1216c
    … …  
    3337#include "indicesol.h"
    3438#include  "control.h"
    35 #include "clesphys.h"
    3639      REAL :: masque(iip1,jjp1)
    3740!      REAL :: pctsrf(iim*(jjm-1)+2, nbsrf)
    … …  
    4144         call init_const_lmdz(
    4245     $        nbtr,anneeref,dayref,
    43      $        iphysiq,day_step,nday)
     46     $        iphysiq, day_step,nday)
    4447#endif
    4548         print *, 'nbtr =' , nbtr
    … …  
    5760     &                 for 1 process and 1 task')
    5861      ENDIF
    59       CALL phys_state_var_init
    6062      call InitComgeomphy
    61      
     63
     64#ifdef CPP_IOIPSL
     65      call ioconf_calendar('360d')
     66#endif
    6267
    6368      WRITE(6,*) '  *********************  '
    … …  
    76811     FORMAT(//)
    7782
     83#endif
     84! of #ifdef CPP_EARTH
    7885      STOP
    7986      END

  • LMDZ4/trunk/libf/dyn3dpar/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/dyn3dpar/disvert.F

    r1000 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/dyn3dpar/dump2d.F

    r774 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/dyn3dpar/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
    … …  
    457465      dims4(3) = idim_s
    458466      dims4(4) = idim_tim
    459 
     467      IF(nqtot.GE.1) THEN
    460468      DO iq=1,nqtot
    461469cIM 220306 BEG
    … …  
    468476      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
    469477      ENDDO
     478      ENDIF
    470479c
    471480      dims4(1) = idim_rlonv
    … …  
    631640      END IF
    632641
     642      IF(nqtot.GE.1) THEN
    633643      do iq=1,nqtot
    634644
    … …  
    701711     
    702712      ENDDO
     713      ENDIF
    703714c
    704715      ierr = NF_INQ_VARID(nid, "masse", nvarid)

  • LMDZ4/trunk/libf/dyn3dpar/dynredem_p.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44c
    55      SUBROUTINE dynredem0_p(fichnom,iday_end,phis)
     6#ifdef CPP_IOIPSL
    67      USE IOIPSL
     8#endif
    79      USE parallel
    810      USE infotrac
    … …  
    5759      if (mpi_rank==0) then
    5860     
    59       modname='dynredem'
    60 
     61      modname='dynredem0_p'
     62
     63#ifdef CPP_IOIPSL
    6164      call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
    6265      call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
    63        
     66#else
     67! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
     68      yyears0=0
     69      mmois0=1
     70      jjour0=1
     71#endif               
    6472
    6573      DO l=1,length

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

    r1146 r1279  
    99      USE ioipsl
    1010      USE dimphy
     11      USE infotrac
    1112      USE fonte_neige_mod
    1213      USE pbl_surface_mod
    1314      USE phys_state_var_mod
    1415      USE filtreg_mod
    15       USE infotrac
     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"
    … …  
    4345      ! local variables:
    4446      REAL :: latfi(klon), lonfi(klon)
    45       REAL :: orog(iip1,jjp1), rugo(iip1,jjp1),
    46      . psol(iip1, jjp1), phis(iip1, jjp1)
     47      REAL :: orog(iip1,jjp1), rugo(iip1,jjp1)
     48      REAL :: psol(iip1, jjp1), phis(iip1, jjp1)
    4749      REAL :: p3d(iip1, jjp1, llm+1)
    4850      REAL :: uvent(iip1, jjp1, llm)
    … …  
    5254      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
    77       INTEGER :: nq
    7880      REAL :: xpi
    7981      !
    … …  
    103105      REAL :: w(ip1jmp1,llm)
    104106      REAL ::phystep
    105       REAL :: rugsrel(iip1*jjp1)
     107CC      REAL :: rugsrel(iip1*jjp1)
    106108      REAL :: fder(klon)
    107       real zrel(iip1*jjp1),chmin,chmax
    108 
    109       CHARACTER*80 :: visu_file
     109!!      real zrel(iip1*jjp1),chmin,chmax
     110
     111!!      CHARACTER(len=80) :: visu_file
    110112      INTEGER :: visuid
    111113
    … …  
    127129      logical              :: ok_journe, ok_mensuel, ok_instan, ok_hf
    128130      logical              :: ok_LES
    129       LOGICAL              :: ok_ade, ok_aie, aerosol_couple
     131      LOGICAL              :: ok_ade, ok_aie, aerosol_couple, new_aod
     132      INTEGER              :: flag_aerosol
    130133      REAL                 :: bl95_b0, bl95_b1
    131134      real                 :: fact_cldcon, facttemps,ratqsbas,ratqshaut
     135      real                 :: tau_ratqs
    132136      integer              :: iflag_cldcon
    133137      integer              :: iflag_ratqs
    … …  
    141145      real :: seuil_inversion
    142146
     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
    143154      !
    144155      !   Constantes
    … …  
    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
    175190
    176191      dtvr   = daysec/FLOAT(day_step)
    … …  
    179194      CALL iniconst()
    180195      CALL inigeom()
    181       !
     196
     197! Initialisation pour traceurs
     198      call infotrac_init
     199      ALLOCATE(q3d(iip1, jjp1, llm, nqtot))
     200
    182201      CALL inifilr()
    183 C init pour traceurs
    184       call infotrac_init
    185       ALLOCATE(q3d(iip1, jjp1, llm,nqtot))
    186 !      CALL phys_state_var_init()
     202      CALL phys_state_var_init(read_climoz)
    187203      !
    188204      latfi(1) = ASIN(1.0)
    … …  
    241257
    242258      write(*,*)'Essai de lecture masque ocean'
    243       iret = nf_open("o2a.nc", NF_NOWRITE, nid_o2a)
     259      iret = nf90_open("o2a.nc", NF90_NOWRITE, nid_o2a)
    244260      if (iret .ne. 0) then
    245261        write(*,*)'ATTENTION!! pas de fichier o2a.nc trouve'
    … …  
    260276      else
    261277        couple = .true.
    262         iret = nf_close(nid_o2a)
     278        iret = nf90_close(nid_o2a)
    263279        call flininfo("o2a.nc", iml_omask, jml_omask, llm_tmp, ttm_tmp
    264280     $    , nid_o2a)
    … …  
    397413     .                           maxval(qsat(:,:,:))
    398414      !
    399       WRITE(*,*) 'QSAT :', qsat(10,20,:)
     415CC      WRITE(*,*) 'QSAT :', qsat(10,20,:)
    400416      !
    401417      varname = 'q'
    … …  
    408424      q3d(:,:,:,1) = qd(:,:,:)
    409425      !
     426
     427!     Ozone climatology:
     428      if (read_climoz >= 1) call regr_lat_time_climoz(read_climoz)
     429
    410430      varname = 'tsol'
    411431      ! This line needs to be replaced by a call to restget to get the values in the restart file
    … …  
    472492     .     jjm, rlonu, rlatv , interbar )
    473493c
    474       rugsrel(:) = 0.0
    475       IF(ok_orodr)  THEN
    476         DO i = 1, iip1* jjp1
    477          rugsrel(i) = MAX( 1.e-05, zstd(i)* zsig(i) /2. )
    478         ENDDO
    479       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
    480500
    481501
    … …  
    647667      itau_phy = 0
    648668      iday = dayref +itau/day_step
    649       time = FLOAT(itau-(iday-dayref)*day_step)/day_step
     669      time = real(itau-(iday-dayref)*day_step)/day_step
    650670c     
    651671      IF(time.GT.1)  THEN
    … …  
    748768
    749769C     Sortie Visu pour les champs dynamiques
    750       if (1.eq.0 ) then
    751       print*,'sortie visu'
    752       time_step = 1.
    753       t_ops = 2.
    754       t_wrt = 2.
    755       itau = 2.
    756       visu_file='Etat0_visu.nc'
    757       CALL initdynav(visu_file,dayref,anneeref,time_step,
    758      .              t_ops, t_wrt, visuid)
    759       CALL writedynav(visuid, itau,vvent ,
    760      .                uvent,tpot,pk,phi,q3d,masse,psol,phis)
    761       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
    762782         print*,'CCCCCCCCCCCCCCCCCC REACTIVER SORTIE VISU DANS ETAT0'
    763       endif
     783cc      endif
    764784      print*,'entree histclo'
    765785      CALL histclo
    … …  
    770790      !
    771791      END SUBROUTINE etat0_netcdf
    772 

  • LMDZ4/trunk/libf/dyn3dpar/fluxstokenc_p.F

    r1146 r1279  
     1!
     2! $Id$
     3!
    14      SUBROUTINE fluxstokenc_p(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
    … …  
    2126#include "tracstoke.h"
    2227#include "temps.h"
     28#include "iniprint.h"
    2329
    2430      REAL time_step,t_wrt, t_ops
    … …  
    236242      ENDIF ! if iadvtr.EQ.istdyn
    237243
     244#else
     245      write(lunout,*)
     246     & 'fluxstokenc: Needs Earth physics (and ioipsl) to function'
     247#endif
     248! of #ifdef CPP_EARTH
    238249      RETURN
    239250      END

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

    r774 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/dyn3dpar/fyhyp.F

    r764 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/dyn3dpar/gcm.F

    r1147 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44c
    … …  
    1212      USE mod_const_mpi, ONLY: init_const_mpi
    1313      USE parallel
    14       USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb
    1514      USE infotrac
    1615      USE mod_interface_dyn_phys
    1716      USE mod_hallo
    1817      USE Bands
    19 
     18      USE getparam
    2019      USE filtreg_mod
    2120
    … …  
    2322#ifdef CPP_EARTH
    2423      USE mod_grid_phy_lmdz
     24      USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb
    2525      USE mod_phys_lmdz_omp_data, ONLY: klon_omp
    2626      USE dimphy
    … …  
    113113      real time_step, t_wrt, t_ops
    114114
    115 c      REAL rdayvrai,rdaym_ini,rday_ecri
    116 c      LOGICAL first
    117115
    118116      LOGICAL call_iniphys
    … …  
    133131
    134132      character (len=80) :: dynhist_file, dynhistave_file
    135       character (len=20) ::modname
    136       character (len=80) ::abort_message
    137 
    138 C Calendrier
    139       LOGICAL true_calendar
    140       PARAMETER (true_calendar = .false.)
     133      character (len=20) :: modname
     134      character (len=80) :: abort_message
     135! locales pour gestion du temps
     136      INTEGER :: an, mois, jour
     137      REAL :: heure
     138
    141139
    142140c-----------------------------------------------------------------------
    … …  
    165163
    166164
    167 c-----------------------------------------------------------------------
    168 c   Choix du calendrier
    169 c   -------------------
    170 
    171 #ifdef CPP_IOIPSL
    172       if (true_calendar) then
    173         call ioconf_calendar('gregorian')
    174       else
    175         call ioconf_calendar('360d')
    176       endif
    177 #endif
     165
    178166c----------------------------------------------------------------------
    179167c  lecture des fichiers gcm.def ou run.def
    … …  
    194182
    195183      call init_parallel
     184      call ini_getparam("out.def")
    196185      call Read_Distrib
    197186! Ehouarn : temporarily (?) keep this only for Earth
    … …  
    202191      endif ! of if (planet_type.eq."earth")
    203192      CALL set_bands
     193#ifdef CPP_EARTH
     194! Ehouarn: For now only Earth physics is parallel
    204195      CALL Init_interface_dyn_phys
     196#endif
    205197      CALL barrier
    206198
    … …  
    220212#endif
    221213      endif ! of if (planet_type.eq."earth")
     214
     215c-----------------------------------------------------------------------
     216c   Choix du calendrier
     217c   -------------------
     218
     219c      calend = 'earth_365d'
     220
     221#ifdef CPP_IOIPSL
     222      if (calend == 'earth_360d') then
     223        call ioconf_calendar('360d')
     224        write(lunout,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
     225      else if (calend == 'earth_365d') then
     226        call ioconf_calendar('noleap')
     227        write(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
     228      else if (calend == 'earth_366d') then
     229        call ioconf_calendar('gregorian')
     230        write(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
     231      else
     232        abort_message = 'Mauvais choix de calendrier'
     233        call abort_gcm(modname,abort_message,1)
     234      endif
     235#endif
    222236
    223237      IF (config_inca /= 'none') THEN
    … …  
    305319      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
    306320        write(lunout,*)
    307      .  ' Attention les dates initiales lues dans le fichier'
     321     .  'GCM: Attention les dates initiales lues dans le fichier'
    308322        write(lunout,*)
    309323     .  ' restart ne correspondent pas a celles lues dans '
    310324        write(lunout,*)' gcm.def'
     325        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
     326        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
    311327        if (raz_date .ne. 1) then
    312328          write(lunout,*)
    313      .    ' On garde les dates du fichier restart'
     329     .    'GCM: On garde les dates du fichier restart'
    314330        else
    315331          annee_ref = anneeref
    … …  
    320336          time_0 = 0.
    321337          write(lunout,*)
    322      .   ' On reinitialise a la date lue dans gcm.def'
     338     .   'GCM: On reinitialise a la date lue dans gcm.def'
    323339        endif
    324340      ELSE
    325341        raz_date = 0
    326342      endif
     343
    327344#ifdef CPP_IOIPSL
    328       call ioconf_startdate(annee_ref,0,day_ref,0.)
    329 #endif
    330 
     345      mois = 1
     346      heure = 0.
     347      call ymds2ju(annee_ref, mois, day_ref, heure, jD_ref)
     348      jH_ref = jD_ref - int(jD_ref)
     349      jD_ref = int(jD_ref)
     350
     351      call ioconf_startdate(INT(jD_ref), jH_ref)
     352
     353      write(lunout,*)'DEBUG'
     354      write(lunout,*)'annee_ref, mois, day_ref, heure, jD_ref'
     355      write(lunout,*)annee_ref, mois, day_ref, heure, jD_ref
     356      call ju2ymds(jD_ref+jH_ref,an, mois, jour, heure)
     357      write(lunout,*)'jD_ref+jH_ref,an, mois, jour, heure'
     358      write(lunout,*)jD_ref+jH_ref,an, mois, jour, heure
     359#else
     360! Ehouarn: we still need to define JD_ref and JH_ref
     361! and since we don't know how many days there are in a year
     362! we set JD_ref to 0 (this should be improved ...)
     363      jD_ref=0
     364      jH_ref=0
     365#endif
    331366
    332367c  nombre d'etats dans les fichiers demarrage et histoire
    … …  
    405440
    406441c-----------------------------------------------------------------------
    407 c   Initialisation des dimensions d'INCA :
    408 c   --------------------------------------
    409       IF (config_inca /= 'none') THEN
    410 !$OMP PARALLEL
    411 #ifdef INCA
    412          CALL init_inca_dim(klon_omp,llm,iim,jjm,
    413      $        rlonu,rlatu,rlonv,rlatv)
    414 #endif
    415 !$OMP END PARALLEL
    416       END IF
    417 
    418 c-----------------------------------------------------------------------
    419442c   Initialisation des I/O :
    420443c   ------------------------
    … …  
    425448 300  FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)
    426449
    427 !#ifdef CPP_IOIPSL
     450#ifdef CPP_IOIPSL
     451      call ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure)
     452      write (lunout,301)jour, mois, an
     453      call ju2ymds(jD_ref + day_end - day_ref, an, mois, jour, heure)
     454      write (lunout,302)jour, mois, an
     455 301  FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4)
     456 302  FORMAT('1'/,15x,'    au ', i2,'/',i2,'/',i4)
     457#endif
     458
    428459      if (planet_type.eq."earth") then
    429 #ifdef CPP_EARTH
    430       CALL dynredem0_p("restart.nc", day_end, phis)
    431 #endif
     460        CALL dynredem0_p("restart.nc", day_end, phis)
    432461      endif
    433462
    … …  
    439468      t_ops = iecri * daysec
    440469      t_wrt = iecri * daysec
    441       CALL inithist_p(dynhist_file,day_ref,annee_ref,time_step,
    442      .              t_ops, t_wrt, histid, histvid)
     470!      CALL inithist_p(dynhist_file,day_ref,annee_ref,time_step,
     471!     .              t_ops, t_wrt, histid, histvid)
    443472
    444473      IF (ok_dynzon) THEN
    445474         t_ops = iperiod * time_step
    446475         t_wrt = periodav * daysec
    447          CALL initdynav_p(dynhistave_file,day_ref,annee_ref,time_step,
    448      .        t_ops, t_wrt, histaveid)
     476!         CALL initdynav_p(dynhistave_file,day_ref,annee_ref,time_step,
     477!     .        t_ops, t_wrt, histaveid)
    449478      END IF
    450479      dtav = iperiod*dtvr/daysec

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

    r774 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
    … …  
    1218CONTAINS
    1319  SUBROUTINE ini_getparam(fichier)
     20  USE parallel
    1421    !
    1522    IMPLICIT NONE
    1623    !
    1724    CHARACTER*(*) :: fichier
    18     open(out_eff,file=fichier,status='unknown',form='formatted')
     25    IF (mpi_rank==0) OPEN(out_eff,file=fichier,status='unknown',form='formatted')
     26   
    1927  END SUBROUTINE ini_getparam
    2028
    2129  SUBROUTINE fin_getparam
     30  USE parallel
    2231    !
    2332    IMPLICIT NONE
    2433    !
    25     close(out_eff)
     34      IF (mpi_rank==0) CLOSE(out_eff)
    2635
    2736  END SUBROUTINE fin_getparam
    2837
    2938  SUBROUTINE getparamr(TARGET,def_val,ret_val,comment)
     39  USE parallel
    3040    !
    3141    IMPLICIT NONE
    … …  
    4454    call getin(TARGET,ret_val)
    4555
    46     write(out_eff,*) '######################################'
    47     write(out_eff,*) '#### ',comment,' #####'
    48     write(out_eff,*) TARGET,'=',ret_val
    49 
     56    IF (mpi_rank==0) THEN
     57      write(out_eff,*) '######################################'
     58      write(out_eff,*) '#### ',comment,' #####'
     59      write(out_eff,*) TARGET,'=',ret_val
     60    ENDIF
     61   
    5062  END SUBROUTINE getparamr
    5163
    5264  SUBROUTINE getparami(TARGET,def_val,ret_val,comment)
     65  USE parallel
    5366    !
    5467    IMPLICIT NONE
    … …  
    6780    call getin(TARGET,ret_val)
    6881
    69     write(out_eff,*) '######################################'
    70     write(out_eff,*) '#### ',comment,' #####'
    71     write(out_eff,*) comment
    72     write(out_eff,*) TARGET,'=',ret_val
    73 
     82    IF (mpi_rank==0) THEN
     83      write(out_eff,*) '######################################'
     84      write(out_eff,*) '#### ',comment,' #####'
     85      write(out_eff,*) comment
     86      write(out_eff,*) TARGET,'=',ret_val
     87    ENDIF
     88   
    7489  END SUBROUTINE getparami
    7590
    7691  SUBROUTINE getparaml(TARGET,def_val,ret_val,comment)
     92  USE parallel
    7793    !
    7894    IMPLICIT NONE
    … …  
    91107    call getin(TARGET,ret_val)
    92108
    93     write(out_eff,*) '######################################'
    94     write(out_eff,*) '#### ',comment,' #####'
    95     write(out_eff,*) TARGET,'=',ret_val
    96 
     109    IF (mpi_rank==0) THEN
     110      write(out_eff,*) '######################################'
     111      write(out_eff,*) '#### ',comment,' #####'
     112      write(out_eff,*) TARGET,'=',ret_val
     113    ENDIF
     114       
    97115  END SUBROUTINE getparaml
    98116

  • LMDZ4/trunk/libf/dyn3dpar/gr_dyn_fi_p.F

    r774 r1279  
     1!
     2! $Id$
     3!
    14      SUBROUTINE gr_dyn_fi_p(nfield,im,jm,ngrid,pdyn,pfi)
     5#ifdef CPP_EARTH
     6! Interface with parallel physics,
     7! for now this routine only works with Earth physics
    28      USE mod_interface_dyn_phys
    39      USE dimphy
    … …  
    3440      ENDDO
    3541c$OMP END DO NOWAIT
     42#else
     43      write(lunout,*) "gr_fi_dyn_p : This routine should not be called",
     44     &   "without parallelized physics"
     45      stop
     46#endif
     47! of #ifdef CPP_EARTH
    3648      RETURN
    3749      END

  • LMDZ4/trunk/libf/dyn3dpar/gr_fi_dyn_p.F

    r774 r1279  
     1!
     2! $Id$
     3!
    14      SUBROUTINE gr_fi_dyn_p(nfield,ngrid,im,jm,pfi,pdyn)
     5#ifdef CPP_EARTH
     6! Interface with parallel physics,
     7! for now this routine only works with Earth physics
    28      USE mod_interface_dyn_phys
    39      USE dimphy
    … …  
    4652      ENDDO
    4753c$OMP END DO NOWAIT
     54#else
     55      write(lunout,*) "gr_fi_dyn_p : This routine should not be called",
     56     &   "without parallelized physics"
     57      stop
     58#endif
     59! of #ifdef CPP_EARTH
    4860      RETURN
    4961      END

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

    r774 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/dyn3dpar/groupeun_p.F

    r1146 r1279  
    11      SUBROUTINE groupeun_p(jjmax,llmax,jjb,jje,q)
    22      USE parallel
     3      USE Write_Field_p
    34      IMPLICIT NONE
    45
    … …  
    1718      REAL airecs,qs
    1819
    19       INTEGER i,j,l,ig,j1,j2,i0,jd
     20      INTEGER i,j,l,ig,ig2,j1,j2,i0,jd
    2021
    2122c--------------------------------------------------------------------c
    … …  
    3738      LOGICAL, SAVE :: first = .TRUE.
    3839!$OMP THREADPRIVATE(first)
     40      INTEGER,SAVE :: i_index(iim,ngroup)
     41      INTEGER      :: offset
     42      REAL         :: qsum(iim/ngroup)
    3943
    4044      IF (first) THEN
    … …  
    5458            j_start  = MAX(jjb, j1-jd)
    5559            j_finish = MIN(jje, 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  = MAX(1+jjp1-jje-jd, j1-jd)
    7190            j_finish = MIN(1+jjp1-jjb-jd, 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

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

    r774 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/dyn3dpar/infotrac.F90

    r1146 r1279  
     1! $Id$
     2!
    13MODULE infotrac
    24
    35! nqtot : total number of tracers and higher order of moment, water vapor and liquid included
    46  INTEGER, SAVE :: nqtot
    5 !!$OMP THREADPRIVATE(nqtot)   
    67
    78! nbtr : number of tracers not including higher order of moment or water vapor or liquid
    89!        number of tracers used in the physics
    910  INTEGER, SAVE :: nbtr
    10 !!$OMP THREADPRIVATE(nbtr)   
    1111
    1212! Name variables
    1313  CHARACTER(len=20), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics
    1414  CHARACTER(len=23), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics
    15 !!$OMP THREADPRIVATE(tname,ttext)   
    1615
    1716! iadv  : index of trasport schema for each tracer
    1817  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: iadv
    19 !!$OMP THREADPRIVATE(iadv)   
    2018
    2119! niadv : vector keeping the coorspondance between all tracers(nqtot) treated in the
    2220!         dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code.
    2321  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: niadv ! equivalent dyn / physique
    24 !!$OMP THREADPRIVATE(niadv)   
    25 
    26 ! Variables for INCA
     22
     23! conv_flg(it)=0 : convection desactivated for tracer number it
    2724  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: conv_flg
     25! pbl_flg(it)=0  : boundary layer diffusion desactivaded for tracer number it
    2826  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: pbl_flg
    29 !!$OMP THREADPRIVATE(conv_flg, pbl_flg)   
    30 
     27
     28  CHARACTER(len=4),SAVE :: type_trac
     29 
    3130CONTAINS
    3231
    … …  
    5756    INTEGER, ALLOCATABLE, DIMENSION(:) :: vadv  ! index of vertical trasport schema
    5857
    59     CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
     58    CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
    6059    CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: tracnam ! name from INCA
    6160    CHARACTER(len=3), DIMENSION(30) :: descrq
    … …  
    8483    descrq(20)='SLP'
    8584    descrq(30)='PRA'
     85   
     86
     87    IF (config_inca=='none') THEN
     88       type_trac='lmdz'
     89    ELSE
     90       type_trac='inca'
     91    END IF
    8692
    8793!-----------------------------------------------------------------------
    … …  
    9197!
    9298!-----------------------------------------------------------------------
    93     IF (config_inca == 'none') THEN
     99    IF (type_trac == 'lmdz') THEN
    94100       OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
    95101       IF(ierr.EQ.0) THEN
    … …  
    113119    END IF
    114120!
    115 ! Allocate variables depending on nqtrue
     121! Allocate variables depending on nqtrue and nbtr
    116122!
    117123    ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue))
    118 
    119     IF (config_inca /= 'none') THEN
    120        ! Varaibles only needed in case of INCA
    121        ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), tracnam(nbtr))
    122     END IF
    123        
     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
    124128!-----------------------------------------------------------------------
    125129! 2)     Choix  des schemas d'advection pour l'eau et les traceurs
    … …  
    148152!    Get choice of advection schema from file tracer.def or from INCA
    149153!---------------------------------------------------------------------
    150     IF (config_inca == 'none') THEN
     154    IF (type_trac == 'lmdz') THEN
    151155       IF(ierr.EQ.0) THEN
    152156          ! Continue to read tracer.def
    … …  
    176180       END DO
    177181
    178     ELSE  ! config_inca='aero' ou 'chem'
     182    ELSE  ! type_trac=inca : config_inca='aero' ou 'chem'
    179183! le module de chimie fournit les noms des traceurs
    180184! et les schemas d'advection associes.
    … …  
    195199       END DO
    196200
    197     END IF ! config_inca
     201    END IF ! type_trac
    198202
    199203!-----------------------------------------------------------------------
    … …  
    299303
    300304
    301     WRITE(lunout,*) 'Information stored in dimtrac :'
     305    WRITE(lunout,*) 'Information stored in infotrac :'
    302306    WRITE(lunout,*) 'iadv  niadv tname  ttext :'
    303307    DO iq=1,nqtot
    … …  
    305309    END DO
    306310
     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
    307325!-----------------------------------------------------------------------
    308326! Finalize :
    309327!
    310328    DEALLOCATE(tnom_0, hadv, vadv)
    311     IF (config_inca /= 'none') DEALLOCATE(tracnam)
    312 
    313 999 FORMAT (i2,1x,i2,1x,a8)
     329    DEALLOCATE(tracnam)
     330
     331999 FORMAT (i2,1x,i2,1x,a15)
    314332
    315333  END SUBROUTINE infotrac_init

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

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

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

    r774 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/dyn3dpar/initdynav_p.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    4 c
    5 c
    64      subroutine initdynav_p(infile,day0,anne0,tstep,t_ops,t_wrt,fileid)
    75
     6#ifdef CPP_IOIPSL
     7! This routine needs IOIPSL
    88       USE IOIPSL
     9#endif
    910       use parallel
    1011       use Write_field
    … …  
    5051#include "description.h"
    5152#include "serre.h"
     53#include "iniprint.h"
    5254
    5355C   Arguments
    … …  
    5759      real tstep, t_ops, t_wrt
    5860      integer fileid
     61
     62#ifdef CPP_IOIPSL
     63! This routine needs IOIPSL
     64C   Variables locales
     65C
    5966      integer thoriid, zvertiid
    60 
    61 C   Variables locales
    62 C
    6367      integer tau0
    6468      real zjulian
    … …  
    193197C
    194198      call histend(fileid)
     199#else
     200      write(lunout,*)'initdynav_p: Needs IOIPSL to function'
     201#endif
     202! #endif of #ifdef CPP_IOIPSL
    195203      return
    196204      end

  • LMDZ4/trunk/libf/dyn3dpar/initfluxsto_p.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      subroutine initfluxsto_p
    … …  
    66     .                    fileid,filevid,filedid)
    77
     8#ifdef CPP_IOIPSL
     9! This routine needs IOIPSL
    810       USE IOIPSL
     11#endif
    912       use parallel
    1013       use Write_field
    … …  
    5053#include "description.h"
    5154#include "serre.h"
     55#include "iniprint.h"
    5256
    5357C   Arguments
    5458C
    5559      character*(*) infile
    56       integer*4 itau
    5760      real tstep, t_ops, t_wrt
    5861      integer fileid, filevid,filedid
    59       integer ndex(1)
     62
     63#ifdef CPP_IOIPSL
     64! This routine needs IOIPSL
     65C   Variables locales
     66C
    6067      real nivd(1)
    61 
    62 C   Variables locales
    63 C
    6468      integer tau0
    6569      real zjulian
    … …  
    285289      endif
    286290       
     291#else
     292      write(lunout,*)'initfluxsto_p: Needs IOIPSL to function'
     293#endif
     294! #endif of #ifdef CPP_IOIPSL
    287295      return
    288296      end

  • LMDZ4/trunk/libf/dyn3dpar/inithist_p.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      subroutine inithist_p(infile,day0,anne0,tstep,t_ops,t_wrt,
    55     .                      fileid,filevid)
    66
     7#ifdef CPP_IOIPSL
     8! This routine needs IOIPSL
    79       USE IOIPSL
     10#endif
    811       use parallel
    912       use Write_field
    … …  
    5053#include "description.h"
    5154#include "serre.h"
     55#include "iniprint.h"
    5256
    5357C   Arguments
    … …  
    5862      integer fileid, filevid
    5963
     64#ifdef CPP_IOIPSL
     65! This routine needs IOIPSL
    6066C   Variables locales
    6167C
    … …  
    244250      call histend(fileid)
    245251      call histend(filevid)
     252#else
     253      write(lunout,*)'inithist_p: Needs IOIPSL to function'
     254#endif
     255! #endif of #ifdef CPP_IOIPSL
    246256      return
    247257      end

  • LMDZ4/trunk/libf/dyn3dpar/integrd_p.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      SUBROUTINE integrd_p
    … …  
    3232#include "temps.h"
    3333#include "serre.h"
     34#include "control.h"
    3435
    3536c   Arguments:
    … …  
    264265      ijb=ij_begin
    265266      ije=ij_end
    266      
     267
     268         if (planet_type.eq."earth") then
     269! Earth-specific treatment of first 2 tracers (water)
    267270c$OMP BARRIER
    268271c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    269          DO l = 1, llm
    270           DO ij = ijb, ije
    271            deltap(ij,l) =  p(ij,l) - p(ij,l+1)
     272          DO l = 1, llm
     273           DO ij = ijb, ije
     274            deltap(ij,l) =  p(ij,l) - p(ij,l+1)
     275           ENDDO
    272276          ENDDO
    273          ENDDO
    274 c$OMP END DO NOWAIT
    275 c$OMP BARRIER
    276 
    277          CALL qminimum_p( q, nq, deltap )
     277c$OMP END DO NOWAIT
     278c$OMP BARRIER
     279
     280          CALL qminimum_p( q, nq, deltap )
     281         endif ! of if (planet_type.eq."earth")
    278282c
    279283c    .....  Calcul de la valeur moyenne, unique  aux poles pour  q .....

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

    r774 r1279  
    8181
    8282      DO idat = 1, idatmax
    83        xxd(idat) = AMOD( xxd(idat) - xim0, 360. )
     83       xxd(idat) = MOD( xxd(idat) - xim0, 360. )
    8484       fdd(idat) = fdat (idat)
    8585      ENDDO
    … …  
    212212     
    213213
    214 3      FORMAT(1x,70(1h-))
     2143      FORMAT(1x,70("-"))
    2152152      FORMAT(1x,8f8.2)
    216216

  • LMDZ4/trunk/libf/dyn3dpar/leapfrog_p.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44c
    … …  
    1818       USE timer_filtre, ONLY : print_filtre_timer
    1919       USE infotrac
     20       USE guide_p_mod, ONLY : guide_main
     21       USE getparam
    2022
    2123      IMPLICIT NONE
    … …  
    118120c
    119121      INTEGER itau,itaufinp1,iav
    120       INTEGER*4  iday ! jour julien
    121       REAL       time ! Heure de la journee en fraction d'1 jour
     122!      INTEGER  iday ! jour julien
     123      REAL       time
    122124
    123125      REAL  SSUM
    … …  
    132134      real time_step, t_wrt, t_ops
    133135
    134       REAL rdayvrai,rdaym_ini
     136! jD_cur: jour julien courant
     137! jH_cur: heure julienne courante
     138      REAL :: jD_cur, jH_cur
     139      INTEGER :: an, mois, jour
     140      REAL :: secondes
     141
    135142      LOGICAL first,callinigrads
    136143
    … …  
    160167      character*80 abort_message
    161168
    162 C Calendrier
    163       LOGICAL true_calendar
    164       PARAMETER (true_calendar = .false.)
    165169
    166170      logical,PARAMETER :: dissip_conservative=.TRUE.
    … …  
    186190      INTEGER :: iapptrac
    187191      INTEGER :: AdjustCount
    188       INTEGER :: var_time
     192!      INTEGER :: var_time
    189193      LOGICAL :: ok_start_timer=.FALSE.
    190194      LOGICAL, SAVE :: firstcall=.TRUE.
    … …  
    205209
    206210      itau = 0
    207       iday = day_ini+itau/day_step
    208       time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
    209          IF(time.GT.1.) THEN
    210           time = time-1.
    211           iday = iday+1
    212          ENDIF
     211!      iday = day_ini+itau/day_step
     212!      time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
     213!         IF(time.GT.1.) THEN
     214!          time = time-1.
     215!          iday = iday+1
     216!         ENDIF
    213217
    214218c Allocate variables depending on dynamic variable nqtot
    … …  
    239243   1  CONTINUE
    240244
    241 c$OMP MASTER
    242 
    243       CALL barrier
    244      
    245 c$OMP END MASTER
    246 c$OMP BARRIER
     245      jD_cur = jD_ref + day_ini - day_ref + int (itau * dtvr / daysec)
     246      jH_cur = jH_ref +                                                 &
     247     &          (itau * dtvr / daysec - int(itau * dtvr / daysec))
     248
    247249
    248250#ifdef CPP_IOIPSL
    249 c$OMP MASTER
    250       if (ok_guide.and.(itaufin-itau-1)*dtvr.gt.21600) then
    251         call guide_pp(itau,ucov,vcov,teta,q,masse,ps)
    252       else
    253         IF(prt_level>9)WRITE(*,*)'attention on ne guide pas les ',
    254      .    '6 dernieres heures'
     251      if (ok_guide) then
     252!$OMP MASTER
     253        call guide_main(itau,ucov,vcov,teta,q,masse,ps)
     254!$OMP END MASTER
     255!$OMP BARRIER
    255256      endif
    256 c$OMP END MASTER
    257257#endif
     258
    258259c
    259260c     IF( MOD( itau, 10* day_step ).EQ.0 )  THEN
    … …  
    545546      call VTb(VTcaldyn)
    546547c$OMP END MASTER
    547       var_time=time+iday-day_ini
     548!      var_time=time+iday-day_ini
    548549
    549550c$OMP BARRIER
    550551!      CALL FTRACE_REGION_BEGIN("caldyn")
     552      time = jD_cur + jH_cur
    551553      CALL caldyn_p
    552554     $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
    553      $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time+iday-day_ini )
     555     $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time )
    554556
    555557!      CALL FTRACE_REGION_END("caldyn")
     558
    556559c$OMP MASTER
    557560      call VTe(VTcaldyn)
    … …  
    560563cc$OMP BARRIER
    561564cc$OMP MASTER
    562 c      call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/)))
    563 c      call WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/)))
    564 c      call WriteField_p('dteta',reshape(dteta,(/iip1,jmp1,llm/)))
    565 c      call WriteField_p('dp',reshape(dp,(/iip1,jmp1/)))
    566 c      call WriteField_p('w',reshape(w,(/iip1,jmp1,llm/)))
    567 c      call WriteField_p('pbaru',reshape(pbaru,(/iip1,jmp1,llm/)))
    568 c      call WriteField_p('pbarv',reshape(pbarv,(/iip1,jjm,llm/)))
    569 c      call WriteField_p('p',reshape(p,(/iip1,jmp1,llmp1/)))
    570 c      call WriteField_p('masse',reshape(masse,(/iip1,jmp1,llm/)))
    571 c      call WriteField_p('pk',reshape(pk,(/iip1,jmp1,llm/)))
     565!      call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/)))
     566!      call WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/)))
     567!      call WriteField_p('dteta',reshape(dteta,(/iip1,jmp1,llm/)))
     568!      call WriteField_p('dp',reshape(dp,(/iip1,jmp1/)))
     569!      call WriteField_p('w',reshape(w,(/iip1,jmp1,llm/)))
     570!      call WriteField_p('pbaru',reshape(pbaru,(/iip1,jmp1,llm/)))
     571!      call WriteField_p('pbarv',reshape(pbarv,(/iip1,jjm,llm/)))
     572!      call WriteField_p('p',reshape(p,(/iip1,jmp1,llmp1/)))
     573!      call WriteField_p('masse',reshape(masse,(/iip1,jmp1,llm/)))
     574!      call WriteField_p('pk',reshape(pk,(/iip1,jmp1,llm/)))
    572575cc$OMP END MASTER
    573576
    … …  
    681684         CALL exner_hyb_p(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
    682685c$OMP BARRIER
    683            rdaym_ini  = itau * dtvr / daysec
    684            rdayvrai   = rdaym_ini  + day_ini
    685 
     686           jD_cur = jD_ref + day_ini - day_ref
     687     $        + int (itau * dtvr / daysec)
     688           jH_cur = jH_ref +                                            &
     689     &              (itau * dtvr / daysec - int(itau * dtvr / daysec))
     690!         call ju2ymds(jD_cur+jH_cur, an, mois, jour, secondes)
    686691
    687692c rajout debug
    … …  
    720725     *                               jj_Nb_physic,2,2,Request_physic)
    721726       
     727        call Register_SwapFieldHallo(masse,masse,ip1jmp1,llm,
     728     *                               jj_Nb_physic,1,2,Request_physic)
     729
    722730        call Register_SwapFieldHallo(p,p,ip1jmp1,llmp1,
    723731     *                               jj_Nb_physic,2,2,Request_physic)
    … …  
    767775cc$OMP BARRIER
    768776!        CALL FTRACE_REGION_BEGIN("calfis")
    769         CALL calfis_p(lafin ,rdayvrai,time  ,
     777        CALL calfis_p(lafin ,jD_cur, jH_cur,
    770778     $               ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
    771779     $               du,dv,dteta,dq,
    … …  
    861869c      ------------------------------
    862870         IF (ok_strato) THEN
    863            CALL top_bound_p( vcov,ucov,teta, dufi,dvfi,dtetafi)
     871           CALL top_bound_p( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
    864872         ENDIF
    865873       
    … …  
    885893     *                               jj_Nb_caldyn,Request_physic)
    886894       
     895        call Register_SwapField(masse,masse,ip1jmp1,llm,
     896     *                               jj_Nb_caldyn,Request_physic)
     897
    887898        call Register_SwapField(p,p,ip1jmp1,llmp1,
    888899     *                               jj_Nb_caldyn,Request_physic)
    … …  
    957968       call Register_Hallo(vcov,ip1jm,llm,1,1,1,1,Request_Physic)
    958969       call SendRequest(Request_Physic)
     970c$OMP BARRIER
    959971       call WaitRequest(Request_Physic)     
    960972
    … …  
    12511263      print *, 'Temps CPU ecoule sur la parallelisation :',DiffCpuTime()
    12521264      CALL print_filtre_timer
     1265      call fin_getparam
    12531266        call finalize_parallel
    12541267c$OMP END MASTER
    … …  
    12641277            IF(forward. OR. leapf) THEN
    12651278              itau= itau + 1
    1266               iday= day_ini+itau/day_step
    1267               time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
    1268                 IF(time.GT.1.) THEN
    1269                   time = time-1.
    1270                   iday = iday+1
    1271                 ENDIF
     1279!              iday= day_ini+itau/day_step
     1280!              time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
     1281!                IF(time.GT.1.) THEN
     1282!                  time = time-1.
     1283!                  iday = iday+1
     1284!                ENDIF
    12721285            ENDIF
    12731286
    … …  
    12761289
    12771290c$OMP MASTER
     1291              call fin_getparam
    12781292              call finalize_parallel
    12791293c$OMP END MASTER
    … …  
    13011315c$OMP BARRIER
    13021316c$OMP MASTER
    1303               CALL writedynav_p(histaveid, itau,vcov ,
    1304      ,                          ucov,teta,pk,phi,q,masse,ps,phis)
     1317!              CALL writedynav_p(histaveid, itau,vcov ,
     1318!     ,                          ucov,teta,pk,phi,q,masse,ps,phis)
    13051319
    13061320c ATTENTION!!! bilan_dyn_p ne marche probablement pas avec OpenMP
    … …  
    13531367#ifdef CPP_IOIPSL
    13541368 
    1355               CALL writehist_p(histid,histvid, itau,vcov,
    1356      &                         ucov,teta,phi,q,masse,ps,phis)
     1369!              CALL writehist_p(histid,histvid, itau,vcov,
     1370!     &                         ucov,teta,phi,q,masse,ps,phis)
    13571371
    13581372#endif
    … …  
    13801394
    13811395              if (planet_type.eq."earth") then
    1382 #ifdef CPP_EARTH
    13831396! Write an Earth-format restart file
    13841397                CALL dynredem1_p("restart.nc",0.0,
    13851398     &                           vcov,ucov,teta,q,masse,ps)
    1386 
    1387 #endif
    13881399              endif ! of if (planet_type.eq."earth")
    13891400
    1390               CLOSE(99)
     1401!              CLOSE(99)
    13911402c$OMP END MASTER
    13921403            ENDIF ! of IF (itau.EQ.itaufin)
    … …  
    14331444
    14341445             itau =  itau + 1
    1435              iday = day_ini+itau/day_step
    1436              time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
    1437 
    1438                   IF(time.GT.1.) THEN
    1439                    time = time-1.
    1440                    iday = iday+1
    1441                   ENDIF
     1446!             iday = day_ini+itau/day_step
     1447!             time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
     1448!
     1449!                  IF(time.GT.1.) THEN
     1450!                   time = time-1.
     1451!                   iday = iday+1
     1452!                  ENDIF
    14421453
    14431454               forward =  .FALSE.
    14441455               IF( itau. EQ. itaufinp1 ) then 
    14451456c$OMP MASTER
     1457                 call fin_getparam
    14461458                 call finalize_parallel
    14471459c$OMP END MASTER
    … …  
    14711483c$OMP BARRIER
    14721484c$OMP MASTER
    1473                CALL writedynav_p(histaveid, itau,vcov ,
    1474      ,                          ucov,teta,pk,phi,q,masse,ps,phis)
     1485!               CALL writedynav_p(histaveid, itau,vcov ,
     1486!     ,                          ucov,teta,pk,phi,q,masse,ps,phis)
    14751487               CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
    14761488     ,           ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
    … …  
    15161528#ifdef CPP_IOIPSL
    15171529
    1518                 CALL writehist_p(histid, histvid, itau,vcov ,
    1519      &                           ucov,teta,phi,q,masse,ps,phis)
     1530!                CALL writehist_p(histid, histvid, itau,vcov ,
     1531!     &                           ucov,teta,phi,q,masse,ps,phis)
    15201532#endif
    15211533! For some Grads output (but does it work?)
    … …  
    15391551              IF(itau.EQ.itaufin) THEN
    15401552                if (planet_type.eq."earth") then
    1541 #ifdef CPP_EARTH
    15421553c$OMP MASTER
    15431554                   CALL dynredem1_p("restart.nc",0.0,
    15441555     .                               vcov,ucov,teta,q,masse,ps)
    15451556c$OMP END MASTER
    1546 #endif
    15471557                endif ! of if (planet_type.eq."earth")
    15481558              ENDIF ! of IF(itau.EQ.itaufin)
    … …  
    15551565      END IF ! of IF(.not.purmats)
    15561566c$OMP MASTER
     1567      call fin_getparam
    15571568      call finalize_parallel
    15581569c$OMP END MASTER

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

    r1012 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/dyn3dpar/mod_const_para.F90

    r1014 r1279  
     1!
     2! $Id$
     3!
    14MODULE mod_const_mpi
    25
    … …  
    811
    912  SUBROUTINE Init_const_mpi
     13#ifdef CPP_IOIPSL
    1014    USE IOIPSL
     15#else
     16! if not using IOIPSL, we still need to use (a local version of) getin
     17    USE ioipsl_getincom
     18#endif
    1119
    1220    IMPLICIT NONE

  • LMDZ4/trunk/libf/dyn3dpar/mod_interface_dyn_phys.F90

    r792 r1279  
     1!
     2! $Id$
     3!
    14MODULE mod_interface_dyn_phys
    25  INTEGER,SAVE,dimension(:),allocatable :: index_i
    … …  
    47 
    58 
     9#ifdef CPP_EARTH
     10! Interface with parallel physics,
     11! for now this routine only works with Earth physics
    612CONTAINS
    713 
    … …  
    4955 
    5056  END SUBROUTINE Init_interface_dyn_phys
    51 
     57#endif
     58! of #ifdef CPP_EARTH
    5259END MODULE mod_interface_dyn_phys

  • LMDZ4/trunk/libf/dyn3dpar/parallel.F90

    r1146 r1279  
     1!
     2! $Id$
     3!
    14  module parallel
    25  USE mod_const_mpi
    … …  
    3336#include "dimensions.h"
    3437#include "paramet.h"
    35    
     38#include "iniprint.h"
     39
    3640      integer :: ierr
    3741      integer :: i,j
    … …  
    8387        if (jj_nb_para(i) <= 2 ) then
    8488         
    85          print *,"Arret : le nombre de bande de lattitude par process est trop faible (<2)."
    86          print *," ---> diminuez le nombre de CPU ou augmentez la taille en lattitude"
     89         write(lunout,*)"Arret : le nombre de bande de lattitude par process est trop faible (<2)."
     90         write(lunout,*)" ---> diminuez le nombre de CPU ou augmentez la taille en lattitude"
    8791         
    8892#ifdef CPP_MPI
    … …  
    127131      endif
    128132       
    129       print *,"jj_begin",jj_begin
    130       print *,"jj_end",jj_end
    131       print *,"ij_begin",ij_begin
    132       print *,"ij_end",ij_end
     133      write(lunout,*)"init_parallel: jj_begin",jj_begin
     134      write(lunout,*)"init_parallel: jj_end",jj_end
     135      write(lunout,*)"init_parallel: ij_begin",ij_begin
     136      write(lunout,*)"init_parallel: ij_end",ij_end
    133137
    134138!$OMP PARALLEL
    … …  
    185189    use mod_prism_proto
    186190#endif
     191#ifdef CPP_EARTH
     192! Ehouarn: surface_data module is in 'phylmd' ...
    187193      use surface_data, only : type_ocean
    188194      implicit none
     195#else
     196      implicit none
     197! without the surface_data module, we declare (and set) a dummy 'type_ocean'
     198      character(len=6),parameter :: type_ocean="dummy"
     199#endif
     200! #endif of #ifdef CPP_EARTH
    189201
    190202      include "dimensions.h"
    … …  
    415427    implicit none
    416428#include "dimensions.h"
    417 #include "paramet.h"   
     429#include "paramet.h"
     430#include "iniprint.h"
    418431#ifdef CPP_MPI
    419432    include 'mpif.h'
    … …  
    436449           call Pack_Data(Field(ij_begin,1),ij,ll,min(jj_end,jjm)-jj_begin+1,Buffer_send)
    437450        else
    438            print *,ij 
     451           write(lunout,*)ij 
    439452        stop 'erreur dans Gather_Field'
    440453        endif

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

    r774 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/dyn3dpar/sortvarc0.F

    r774 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/dyn3dpar/startvar.F

    r1000 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/dyn3dpar/temps.h

    r985 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
     23
    2024!$OMP THREADPRIVATE(/temps/)
     25!-----------------------------------------------------------------------

  • LMDZ4/trunk/libf/dyn3dpar/top_bound_p.F

    r1000 r1279  
    1       SUBROUTINE top_bound_p( vcov,ucov,teta, du,dv,dh )
     1      SUBROUTINE top_bound_p( vcov,ucov,teta,masse, du,dv,dh )
    22      USE parallel
    33      IMPLICIT NONE
    … …  
    66#include "paramet.h"
    77#include "comconst.h"
    8 CC#include "comgeom2.h"
     8#include "comvert.h"
     9#include "comgeom2.h"
    910
    1011
    … …  
    2829c   -------------
    2930
    30 #include "comgeom.h"
    3131#include "comdissipn.h"
    3232
    … …  
    3535
    3636      REAL ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm),teta(iip1,jjp1,llm)
     37      REAL masse(iip1,jjp1,llm)
    3738      REAL dv(iip1,jjm,llm),du(iip1,jjp1,llm),dh(iip1,jjp1,llm)
    3839
    3940c   Local:
    4041c   ------
    41 
     42      REAL massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm),zm
    4243      REAL uzon(jjp1,llm),vzon(jjm,llm),tzon(jjp1,llm)
    4344     
    … …  
    4546      PARAMETER (NDAMP=4)
    4647      integer i
    47       REAL :: rdamp(llm) =
    48      &   (/(0., i =1,llm-NDAMP),0.125E-5,.25E-5,.5E-5,1.E-5/)
    49 
     48      REAL,SAVE :: rdamp(llm)
     49!     &   (/(0., i =1,llm-NDAMP),0.125E-5,.25E-5,.5E-5,1.E-5/)
     50      LOGICAL,SAVE :: first=.true.
    5051      INTEGER j,l,jjb,jje
    5152
    5253
     54      if (iflag_top_bound == 0) return
     55      if (first) then
     56c$OMP BARRIER
     57c$OMP MASTER
     58         if (iflag_top_bound == 1) then
     59! couche eponge dans les 4 dernieres couches du modele
     60             rdamp(:)=0.
     61             rdamp(llm)=tau_top_bound
     62             rdamp(llm-1)=tau_top_bound/2.
     63             rdamp(llm-2)=tau_top_bound/4.
     64             rdamp(llm-3)=tau_top_bound/8.
     65         else if (iflag_top_bound == 2) then
     66! couce eponge dans toutes les couches de pression plus faible que
     67! 100 fois la pression de la derniere couche
     68             rdamp(:)=tau_top_bound
     69     s       *max(presnivs(llm)/presnivs(:)-0.01,0.)
     70         endif
     71         first=.false.
     72         print*,'TOP_BOUND rdamp=',rdamp
     73c$OMP END MASTER
     74c$OMP BARRIER
     75      endif
     76
     77
     78      CALL massbar_p(masse,massebx,masseby)
    5379C  CALCUL DES CHAMPS EN MOYENNE ZONALE:
    5480
    … …  
    6086      do l=1,llm
    6187        do j=jjb,jje
    62           vzon(j,l)=0.
     88          zm=0.
     89          vzon(j,l)=0
    6390          do i=1,iim
    64             vzon(j,l)=vzon(j,l)+vcov(i,j,l)/float(iim)
     91! Rm: on peut travailler directement avec la moyenne zonale de vcov
     92! plutot qu'avec celle de v car le coefficient cv qui relie les deux
     93! ne varie qu'en latitude
     94            vzon(j,l)=vzon(j,l)+vcov(i,j,l)*masseby(i,j,l)
     95            zm=zm+masseby(i,j,l)
    6596          enddo
     97          vzon(j,l)=vzon(j,l)/zm
    6698        enddo
    6799      enddo
    … …  
    87119        do j=jjb,jje
    88120          uzon(j,l)=0.
     121          zm=0.
     122          do i=1,iim
     123            uzon(j,l)=uzon(j,l)+massebx(i,j,l)*ucov(i,j,l)/cu(i,j)
     124            zm=zm+massebx(i,j,l)
     125          enddo
     126          uzon(j,l)=uzon(j,l)/zm
     127        enddo
     128      enddo
     129c$OMP END DO NOWAIT
     130
     131c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
     132      do l=1,llm
     133        do j=jjb,jje
     134          zm=0.
    89135          tzon(j,l)=0.
    90136          do i=1,iim
    91             uzon(j,l)=uzon(j,l)+ucov(i,j,l)/float(iim)
    92             tzon(j,l)=tzon(j,l)+teta(i,j,l)/float(iim)
     137            tzon(j,l)=tzon(j,l)+teta(i,j,l)*masse(i,j,l)
     138            zm=zm+masse(i,j,l)
    93139          enddo
     140          tzon(j,l)=tzon(j,l)/zm
    94141        enddo
    95142      enddo
    … …  
    102149        do j=jjb,jje
    103150          do i=1,iip1
    104             du(i,j,l)=du(i,j,l)-rdamp(l)*(ucov(i,j,l)-uzon(j,l))
     151            du(i,j,l)=du(i,j,l)
     152     s               -rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l))
    105153            dh(i,j,l)=dh(i,j,l)-rdamp(l)*(teta(i,j,l)-tzon(j,l))
    106154          enddo

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

    r774 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/dyn3dpar/writedynav_p.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      subroutine writedynav_p( histid, time, vcov,
    55     ,                          ucov,teta,ppk,phi,q,masse,ps,phis)
    66
     7#ifdef CPP_IOIPSL
     8! This routine needs IOIPSL
    79      USE ioipsl
     10#endif
    811      USE parallel
    912      USE misc_mod
    … …  
    4750#include "description.h"
    4851#include "serre.h"
     52#include "iniprint.h"
    4953
    5054C
    … …  
    6165
    6266
     67#ifdef CPP_IOIPSL
     68! This routine needs IOIPSL
    6369C   Variables locales
    6470C
    … …  
    156162C
    157163      if (ok_sync) call histsync(histid)
     164#else
     165      write(lunout,*)'writedynav_p: Needs IOIPSL to function'
     166#endif
     167! #endif of #ifdef CPP_IOIPSL
    158168      return
    159169      end

  • LMDZ4/trunk/libf/dyn3dpar/writehist_p.F

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      subroutine writehist_p( histid, histvid, time, vcov,
    55     ,                          ucov,teta,phi,q,masse,ps,phis)
    66
     7#ifdef CPP_IOIPSL
     8! This routine needs IOIPSL
    79      USE ioipsl
     10#endif
    811      USE parallel
    912      USE misc_mod
    … …  
    4851#include "description.h"
    4952#include "serre.h"
     53#include "iniprint.h"
    5054
    5155C
    … …  
    6165      integer time
    6266
    63 
     67#ifdef CPP_IOIPSL
     68! This routine needs IOIPSL
    6469C   Variables locales
    6570C
    … …  
    144149        call histsync(histvid)
    145150      endif
     151#else
     152      write(lunout,*)'writehist_p: Needs IOIPSL to function'
     153#endif
     154! #endif of #ifdef CPP_IOIPSL
    146155      return
    147156      end

  • LMDZ4/trunk/libf/filtrez/filtreg.F

    r1146 r1279  
    112112           
    113113            IF( iaire.EQ.1 )  THEN
    114                sdd1_type = type_sddu
    115                sdd2_type = type_unsddu
     114               sdd1_type = type_sddv
     115               sdd2_type = type_unsddv
    116116            ELSE
    117                sdd1_type = type_unsddu
    118                sdd2_type = type_sddu
     117               sdd1_type = type_unsddv
     118               sdd2_type = type_sddv
    119119            ENDIF
    120120

  • LMDZ4/trunk/libf/filtrez/filtreg_mod.F90

    r1146 r1279  
    77
    88  SUBROUTINE inifilr
     9  USE mod_filtre_fft
    910    !
    1011    !    ... H. Upadhyaya, O.Sharma   ...
    … …  
    519520    ENDDO
    520521
     522    IF (use_filtre_fft) THEN
     523       CALL Init_filtre_fft(coefilu,modfrstu,jfiltnu,jfiltsu,  &
     524                           coefilv,modfrstv,jfiltnv,jfiltsv)
     525    ENDIF
     526
    521527    !   ...................................................................
    522528

  • LMDZ4/trunk/libf/filtrez/mod_fft_mkl.F90

    r986 r1279  
    7474      ierr = DftiSetValue(FFT_Handle,DFTI_PLACEMENT,DFTI_NOT_INPLACE)
    7575      ierr = DftiSetValue(FFT_Handle, DFTI_INPUT_DISTANCE, vsize+inc)
    76       ierr = DftiSetValue(FFT_Handle, DFTI_OUTPUT_DISTANCE, vsize/2+1)
     76      ierr = DftiSetValue(FFT_Handle, DFTI_OUTPUT_DISTANCE, (vsize/2+1)*2)
    7777      ierr = DftiCommitDescriptor( FFT_Handle )
    7878!      Forward_handle(nb_vect)%IsAllocated=.TRUE.
    … …  
    114114      ierr = DftiSetValue(FFT_Handle,DFTI_BACKWARD_SCALE,scale_factor)
    115115      ierr = DftiSetValue(FFT_Handle,DFTI_PLACEMENT,DFTI_NOT_INPLACE)
    116       ierr = DftiSetValue(FFT_Handle, DFTI_INPUT_DISTANCE,  vsize/2+1)
     116      ierr = DftiSetValue(FFT_Handle, DFTI_INPUT_DISTANCE,  (vsize/2+1)*2)
    117117      ierr = DftiSetValue(FFT_Handle, DFTI_OUTPUT_DISTANCE, vsize+inc)
    118118      ierr = DftiCommitDescriptor( FFT_Handle )

  • LMDZ4/trunk/libf/filtrez/mod_fft_wrapper.F90

    r986 r1279  
    1919    INTEGER,INTENT(IN)  :: nb_vect
    2020    REAL,INTENT(IN)     :: vect(vsize+inc,nb_vect)
    21     COMPLEX,INTENT(INOUT) :: TF_vect(vsize/2+1,nb_vect)
     21    COMPLEX*16,INTENT(INOUT) :: TF_vect(vsize/2+1,nb_vect)
    2222   
    2323    STOP "wrapper fft : une FFT doit etre specifiee a l'aide d'une clee CPP, sinon utiliser le filtre classique"
    … …  
    2929    INTEGER,INTENT(IN)  :: nb_vect
    3030    REAL,INTENT(INOUT)    :: vect(vsize+inc,nb_vect)
    31     COMPLEX,INTENT(IN ) :: TF_vect(vsize/2+1,nb_vect)
     31    COMPLEX*16,INTENT(IN ) :: TF_vect(vsize/2+1,nb_vect)
    3232 
    3333    STOP "wrapper fft : une FFT doit etre specifiee a l'aide d'une clee CPP, sinon utiliser le filtre classique"

  • LMDZ4/trunk/libf/filtrez/mod_filtre_fft.F90

    r994 r1279  
    118118
    119119    REAL               :: vect(iim+inc,jj_end-jj_begin+1,nbniv)
    120     COMPLEX            :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
     120!    REAL               :: vect_test(iim+inc,jj_end-jj_begin+1,nbniv)
     121    COMPLEX*16         :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
     122!    COMPLEX*16         :: TF_vect_test(iim/2+1,jj_end-jj_begin+1,nbniv)
    121123    INTEGER            :: nb_vect
    122124    INTEGER :: i,j,l
    … …  
    142144    CALL FFT_forward(vect,TF_vect,nb_vect)
    143145
     146!    CALL FFT_forward(vect,TF_vect_test,nb_vect)
     147!      PRINT *,"XXXXXXXXXXXXX Filtre_u_FFT xxxxxxxxxxxx"
     148!      DO j=1,jj_end-jj_begin+1
     149!      DO i=1,iim/2+1
     150!         PRINT *,"====",i,j,"----->",TF_vect_test(i,j,1)
     151!       ENDDO
     152!      ENDDO
     153
    144154    DO l=1,ll_nb
    145155      DO j=1,jj_end-jj_begin+1
    … …  
    149159      ENDDO
    150160    ENDDO
    151  
     161       
    152162    CALL FFT_backward(TF_vect,vect,nb_vect)
    153      
     163!    CALL FFT_backward(TF_vect_test,vect_test,nb_vect)
     164         
    154165!      PRINT *,"XXXXXXXXXXXXX Filtre_u_FFT xxxxxxxxxxxx"
    155166!      DO j=1,jj_end-jj_begin+1
    156 !          DO i=1,iim
    157 !          PRINT *,"====",j,"----->",(vect_tmp(i,j,1)-vect(i,j,1))/ &
    158 !                                    ((vect_tmp(i,j,1)+vect(i,j,1))*0.5+1e-30)
    159 !          ENDDO
     167!         DO i=1,iim
     168!           PRINT *,"====",i,j,"----->",vect_test(i,j,1)
     169!         ENDDO
    160170!      ENDDO
    161      
     171
    162172    ll_nb=0
    163173!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    … …  
    189199
    190200    REAL               :: vect(iim+inc,jj_end-jj_begin+1,nbniv)
    191     COMPLEX            :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
     201    COMPLEX*16         :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
    192202    INTEGER            :: nb_vect
    193203    INTEGER :: i,j,l
    … …  
    250260    REAL,INTENT(INOUT) :: vect_inout(iim+1,nlat,nbniv)
    251261
    252      REAL               :: vect(iim+inc,jj_end-jj_begin+1,nbniv)
    253     COMPLEX            :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
     262    REAL               :: vect(iim+inc,jj_end-jj_begin+1,nbniv)
     263    COMPLEX*16         :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
    254264    INTEGER            :: nb_vect
    255265    INTEGER :: i,j,l

  • LMDZ4/trunk/libf/phylmd/YOECUMF.h

    r776 r1279  
    11!
    2 ! $Header$
     2! $Id$
    33!
    4 C     ----------------------------------------------------------------
    5 C*    *COMMON* *YOECUMF* - PARAMETERS FOR CUMULUS MASSFLUX SCHEME
    6 C     ----------------------------------------------------------------
    7 C
    8       COMMON /YOECUMF/
    9      L                 LMFPEN,LMFSCV,LMFMID,LMFDD,LMFDUDV,
    10      R                 ENTRPEN,ENTRSCV,ENTRMID,ENTRDD,CMFCTOP,
    11      R                 CMFCMAX,CMFCMIN,CMFDEPS,RHCDD,CPRCON
    12 C
     4!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
     5!                 veillez n'utiliser que des ! pour les commentaires
     6!                 et bien positionner les & des lignes de continuation
     7!                 (les placer en colonne 6 et en colonne 73)
     8!
     9!     ----------------------------------------------------------------
     10!*    *COMMON* *YOECUMF* - PARAMETERS FOR CUMULUS MASSFLUX SCHEME
     11!     ----------------------------------------------------------------
     12!
     13      COMMON /YOECUMF/                                                  &
     14     &                 LMFPEN,LMFSCV,LMFMID,LMFDD,LMFDUDV,              &
     15     &                 ENTRPEN,ENTRSCV,ENTRMID,ENTRDD,CMFCTOP,          &
     16     &                 CMFCMAX,CMFCMIN,CMFDEPS,RHCDD,CPRCON
     17
    1318      LOGICAL          LMFPEN,LMFSCV,LMFMID,LMFDD,LMFDUDV
    1419      REAL ENTRPEN, ENTRSCV, ENTRMID, ENTRDD
    1520      REAL CMFCTOP, CMFCMAX, CMFCMIN, CMFDEPS, RHCDD, CPRCON
    16 c$OMP THREADPRIVATE(/YOECUMF/)
    17 C
    18 *if (DOC,declared) <> 'UNKNOWN'
    19 C*    *COMMON* *YOECUMF* - PARAMETERS FOR CUMULUS MASSFLUX SCHEME
    20 C
    21 C     M.TIEDTKE       E. C. M. W. F.      18/1/89
    22 C
    23 C     NAME      TYPE      PURPOSE
    24 C     ----      ----      -------
    25 C
    26 C     LMFPEN    LOGICAL  TRUE IF PENETRATIVE CONVECTION IS SWITCHED ON
    27 C     LMFSCV    LOGICAL  TRUE IF SHALLOW     CONVECTION IS SWITCHED ON
    28 C     LMFMID    LOGICAL  TRUE IF MIDLEVEL    CONVECTION IS SWITCHED ON
    29 C     LMFDD     LOGICAL  TRUE IF CUMULUS DOWNDRAFT      IS SWITCHED ON
    30 C     LMFDUDV   LOGICAL  TRUE IF CUMULUS FRICTION       IS SWITCHED ON
    31 C     ENTRPEN   REAL     ENTRAINMENT RATE FOR PENETRATIVE CONVECTION
    32 C     ENTRSCV   REAL     ENTRAINMENT RATE FOR SHALLOW CONVECTION
    33 C     ENTRMID   REAL     ENTRAINMENT RATE FOR MIDLEVEL CONVECTION
    34 C     ENTRDD    REAL     ENTRAINMENT RATE FOR CUMULUS DOWNDRAFTS
    35 C     CMFCTOP   REAL     RELAT. CLOUD MASSFLUX AT LEVEL ABOVE NONBUOYANC
    36 C     CMFCMAX   REAL     MAXIMUM MASSFLUX VALUE ALLOWED FOR
    37 C     CMFCMIN   REAL     MINIMUM MASSFLUX VALUE (FOR SAFETY)
    38 C     CMFDEPS   REAL     FRACTIONAL MASSFLUX FOR DOWNDRAFTS AT LFS
    39 C     RHCDD     REAL     RELATIVE SATURATION IN DOWNDRAFTS
    40 C     CPRCON    REAL     COEFFICIENTS FOR DETERMINING CONVERSION
    41 C                        FROM CLOUD WATER TO RAIN
    42 *ifend
    43 C     ----------------------------------------------------------------
     21!$OMP THREADPRIVATE(/YOECUMF/)
     22!
     23!*if (DOC,declared) <> 'UNKNOWN'
     24!*    *COMMON* *YOECUMF* - PARAMETERS FOR CUMULUS MASSFLUX SCHEME
     25!
     26!     M.TIEDTKE       E. C. M. W. F.      18/1/89
     27!
     28!     NAME      TYPE      PURPOSE
     29!     ----      ----      -------
     30!
     31!     LMFPEN    LOGICAL  TRUE IF PENETRATIVE CONVECTION IS SWITCHED ON
     32!     LMFSCV    LOGICAL  TRUE IF SHALLOW     CONVECTION IS SWITCHED ON
     33!     LMFMID    LOGICAL  TRUE IF MIDLEVEL    CONVECTION IS SWITCHED ON
     34!     LMFDD     LOGICAL  TRUE IF CUMULUS DOWNDRAFT      IS SWITCHED ON
     35!     LMFDUDV   LOGICAL  TRUE IF CUMULUS FRICTION       IS SWITCHED ON
     36!     ENTRPEN   REAL     ENTRAINMENT RATE FOR PENETRATIVE CONVECTION
     37!     ENTRSCV   REAL     ENTRAINMENT RATE FOR SHALLOW CONVECTION
     38!     ENTRMID   REAL     ENTRAINMENT RATE FOR MIDLEVEL CONVECTION
     39!     ENTRDD    REAL     ENTRAINMENT RATE FOR CUMULUS DOWNDRAFTS
     40!     CMFCTOP   REAL     RELAT. CLOUD MASSFLUX AT LEVEL ABOVE NONBUOYANC
     41!     CMFCMAX   REAL     MAXIMUM MASSFLUX VALUE ALLOWED FOR
     42!     CMFCMIN   REAL     MINIMUM MASSFLUX VALUE (FOR SAFETY)
     43!     CMFDEPS   REAL     FRACTIONAL MASSFLUX FOR DOWNDRAFTS AT LFS
     44!     RHCDD     REAL     RELATIVE SATURATION IN DOWNDRAFTS
     45!     CPRCON    REAL     COEFFICIENTS FOR DETERMINING CONVERSION
     46!                        FROM CLOUD WATER TO RAIN
     47!*ifend
     48!     ----------------------------------------------------------------

  • LMDZ4/trunk/libf/phylmd/aaam_bud.F

    r940 r1279  
    3939c nlon----input-I-Total number of horizontal points that get into physics
    4040c nlev----input-I-Number of vertical levels
    41 c rjour---input-R-Jour compte depuis le debut de la simu (run.def)
    42 c rsec----input-R-Seconde de la journee
    43 c rea-----input-R-Earth radius
    44 c rg------input-R-gravity constant
    45 c ome-----input-R-Earth rotation rate
     41c rjour        -R-Jour compte depuis le debut de la simu (run.def)
     42c rsec         -R-Seconde de la journee
     43c rea          -R-Earth radius
     44c rg           -R-gravity constant
     45c ome          -R-Earth rotation rate
    4646c plat ---input-R-Latitude en degres
    4747c plon ---input-R-Longitude en degres
    … …  
    9494c
    9595      INTEGER iam,nlon,nlev
    96       REAL rjour,rsec,rea,rg,ome
     96      REAL, intent(in):: rjour,rsec,rea,rg,ome
    9797      REAL plat(nlon),plon(nlon),phis(nlon)
    9898      REAL dragu(nlon),liftu(nlon),phyu(nlon)             

  • LMDZ4/trunk/libf/phylmd/aeropt.F

    r766 r1279  
    1616c Arguments:
    1717c
    18       REAL paprs(klon,klev+1)
    19       REAL pplay(klon,klev), t_seri(klon,klev)
    20       REAL msulfate(klon,klev) ! masse sulfate ug SO4/m3  [ug/m^3]
    21       REAL RHcl(klon,klev)     ! humidite relative ciel clair
    22       REAL tau_ae(klon,klev,2) ! epaisseur optique aerosol
    23       REAL piz_ae(klon,klev,2) ! single scattering albedo aerosol
    24       REAL cg_ae(klon,klev,2)  ! asymmetry parameter aerosol
    25       REAL ai(klon)            ! POLDER aerosol index
     18      REAL, INTENT(in) :: paprs(klon,klev+1)
     19      REAL, INTENT(in) :: pplay(klon,klev), t_seri(klon,klev)
     20      REAL, INTENT(in) :: msulfate(klon,klev) ! masse sulfate ug SO4/m3  [ug/m^3]
     21      REAL, INTENT(in) :: RHcl(klon,klev)     ! humidite relative ciel clair
     22      REAL, INTENT(out) :: tau_ae(klon,klev,2) ! epaisseur optique aerosol
     23      REAL, INTENT(out) :: piz_ae(klon,klev,2) ! single scattering albedo aerosol
     24      REAL, INTENT(out) :: cg_ae(klon,klev,2)  ! asymmetry parameter aerosol
     25      REAL, INTENT(out) :: ai(klon)            ! POLDER aerosol index
    2626c
    2727c Local

  • LMDZ4/trunk/libf/phylmd/calcul_simulISCCP.h

    r1045 r1279  
    3131     .            flwp_c, fiwp_c, flwc_c, fiwc_c,
    3232     e            ok_aie,
    33      e            sulfate, sulfate_pi,
     33     e            mass_solu_aero, mass_solu_aero_pi,
    3434     e            bl95_b0, bl95_b1,
    3535     s            cldtaupi, re, fl)
    … …  
    4242     .            flwp_s, fiwp_s, flwc_s, fiwc_s,
    4343     e            ok_aie,
    44      e            sulfate, sulfate_pi,
     44     e            mass_solu_aero, mass_solu_aero_pi,
    4545     e            bl95_b0, bl95_b1,
    4646     s            cldtaupi, re, fl)

  • LMDZ4/trunk/libf/phylmd/clcdrag.F90

    r1071 r1279  
     1!
     2!$Id$
    13!
    24SUBROUTINE clcdrag(knon, nsrf, paprs, pplay,&
    … …  
    9395           FRIH = AMAX1(1./ (1.+3.*CB*zri(i)*ZSCF), 0.1 )
    9496!!$  PB          zcfh1(i) = zcdn(i) * FRIH
    95            zcfh1(i) = 0.8 * zcdn(i) * FRIH
     97!!$ PB           zcfh1(i) = f_cdrag_stable * zcdn(i) * FRIH
     98           zcfh1(i) = f_cdrag_ter * zcdn(i) * FRIH
     99           IF(nsrf.EQ.is_oce) zcfh1(i) = f_cdrag_oce * zcdn(i) * FRIH
     100!!$ PB
    96101           pcfm(i) = zcfm1(i)
    97102           pcfh(i) = zcfh1(i)
    … …  
    106111           zcfm2(i) = zcdn(i)*amax1((1.-2.0*cb*zri(i)*zucf),0.1)
    107112!!$PB            zcfh2(i) = zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
    108            zcfh2(i) = 0.8 * zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
     113           zcfh2(i) = f_cdrag_ter*zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
    109114           pcfm(i) = zcfm2(i)
    110115           pcfh(i) = zcfh2(i)
    … …  
    114119        ENDIF
    115120        zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
    116         IF(nsrf.EQ.is_oce) pcfh(i) =0.8* zcdn(i)*(1.0+zcr**1.25)**(1./1.25)
     121        IF(nsrf.EQ.is_oce) pcfh(i) =f_cdrag_oce* zcdn(i)*(1.0+zcr**1.25)**(1./1.25)
    117122     ENDIF
    118123  END DO

  • LMDZ4/trunk/libf/phylmd/clesphys.h

    r1146 r1279  
    11!
    2 !
     2! $Id$
    33!
    44!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
    … …  
    1212       LOGICAL ok_limitvrai
    1313       INTEGER nbapp_rad, iflag_con
    14        REAL co2_ppm, solaire
    15        REAL*8 RCO2, RCH4, RN2O, RCFC11, RCFC12 
    16        REAL*8 CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt
     14       REAL co2_ppm, co2_ppm0, solaire
     15       REAL(kind=8) RCO2, RCH4, RN2O, RCFC11, RCFC12 
     16       REAL(kind=8) CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt
    1717
    1818!OM ---> correction du bilan d'eau global
    … …  
    3535! Hauteur (imposee) du contenu en eau du sol
    3636           REAL qsol0
     37! Frottement au sol (Cdrag)
     38       Real f_cdrag_ter,f_cdrag_oce
     39! Rugoro
     40       Real f_rugoro
     41
    3742!IM lev_histhf  : niveau sorties 6h
    3843!IM lev_histday : niveau sorties journalieres
    3944!IM lev_histmth : niveau sorties mensuelles
    4045       INTEGER lev_histhf, lev_histday, lev_histmth
    41        CHARACTER*4 type_run
    42 ! aer_type: pour utiliser un fichier constant dans readsulfate
     46       Integer lev_histins, lev_histLES 
     47       CHARACTER(len=4) type_run
     48! aer_type: pour utiliser un fichier constant dans readaerosol
    4349       CHARACTER*8 :: aer_type
    4450       LOGICAL ok_isccp, ok_regdyn
    … …  
    4854       REAL ecrit_LES
    4955       REAL freq_ISCCP, ecrit_ISCCP
     56       REAL freq_COSP
     57       LOGICAL :: ok_cosp
    5058       INTEGER :: ip_ebil_phy, iflag_rrtm
    5159       LOGICAL :: ok_strato
    … …  
    5866     &     , top_height, overlap, cdmmax, cdhmax, ksta, ksta_ter        &
    5967     &     , ok_kzmin, fmagic, pmagic                                   &
     68     &     , f_cdrag_ter,f_cdrag_oce,f_rugoro                           &
    6069     &     , lev_histhf, lev_histday, lev_histmth                       &
    61      &     , type_run, ok_isccp, ok_regdyn                              &
     70     &     , lev_histins, lev_histLES                                   &
     71     &     , type_run, ok_isccp, ok_regdyn, ok_cosp                     &
    6272     &     , lonmin_ins, lonmax_ins, latmin_ins, latmax_ins             &
    6373     &     , ecrit_ins, ecrit_hf, ecrit_hf2mth, ecrit_day               &
    6474     &     , ecrit_mth, ecrit_tra, ecrit_reg                            &
    65      &     , freq_ISCCP, ecrit_ISCCP, ip_ebil_phy                       &
     75     &     , freq_ISCCP, ecrit_ISCCP, freq_COSP, ip_ebil_phy            &
    6676     &     , ok_lic_melt, cvl_corr, aer_type                            &
    67      &     , qsol0, iflag_rrtm, ok_strato,ok_hines,ecrit_LES
     77     &     , qsol0, iflag_rrtm, ok_strato,ok_hines,ecrit_LES            &
     78     &     , co2_ppm0
    6879     
    6980!$OMP THREADPRIVATE(/clesphys/)

  • LMDZ4/trunk/libf/phylmd/clouds_gno.F

    r1163 r1279  
    11!
    2 ! $Id$
     2! $Header$
    33!
    44C
    … …  
    4747     
    4848      INTEGER i,K, n, m
    49       REAL mu(klon), qsat(klon), delta(klon), beta(klon)
    50       real zu2(klon),zv2(klon)
    51       REAL xx(klon), aux(klon), coeff(klon), block(klon)
    52       REAL  dist(klon), fprime(klon), det(klon)
    53       REAL pi, u(klon), v(klon), erfcu(klon), erfcv(klon)
    54       REAL  xx1(klon), xx2(klon)
    55       real erf,kkk
     49      REAL mu(klon), qsat, delta(klon), beta(klon)
     50      real zu2,zv2
     51      REAL xx(klon), aux(klon), coeff, block
     52      REAL  dist, fprime, det
     53      REAL pi, u, v, erfcu, erfcv
     54      REAL  xx1, xx2
     55      real erf,hsqrtlog_2,v2
    5656      real sqrtpi,sqrt2,zx1,zx2,exdel
    5757c lconv = true si le calcul a converge (entre autre si qsub < min_q)
    5858       LOGICAL lconv(klon)
    5959
    60 cym
    61       cldf(:,:)=0.0
     60!cdir arraycomb
     61      cldf  (1:klon,1:ND)=0.0        ! cym
     62      ratqsc(1:klon,1:ND)=0.0
     63      ptconv(1:klon,1:ND)=.false.
     64!cdir end arraycomb
    6265     
    6366      pi = ACOS(-1.)
    6467      sqrtpi=sqrt(pi)
    6568      sqrt2=sqrt(2.)
    66 
    67       ptconv=.false.
    68       ratqsc=0.
    69 
     69      hsqrtlog_2=0.5*SQRT(log(2.))
    7070
    7171      DO 500 K = 1, ND
    … …  
    7474      mu(i) = R(i,K)
    7575      mu(i) = MAX(mu(i),min_mu)
    76       qsat(i) = RS(i,K)
    77       qsat(i) = MAX(qsat(i),min_mu)
    78       delta(i) = log(mu(i)/qsat(i))
    79                                     enddo ! vector
     76      qsat = RS(i,K)
     77      qsat = MAX(qsat,min_mu)
     78      delta(i) = log(mu(i)/qsat)
     79c                                   enddo ! vector
    8080
    8181C
    … …  
    106106c  suffisamment d'eau nuageuse.
    107107
    108                                     do i=1,klon ! vector
     108c                                   do i=1,klon ! vector
    109109
    110110      IF ( QSUB(i,K) .lt. min_Q ) THEN
    … …  
    124124c --  roots of equation v > vmax:
    125125
    126         det(i) = delta(i) + vmax(i)**2.
    127         if (det(i).LE.0.0) vmax(i) = vmax0 + 1.0
    128         det(i) = delta(i) + vmax(i)**2.
    129 
    130         if (det(i).LE.0.) then
     126        det = delta(i) + vmax(i)*vmax(i)
     127        if (det.LE.0.0) vmax(i) = vmax0 + 1.0
     128        det = delta(i) + vmax(i)*vmax(i)
     129
     130        if (det.LE.0.) then
    131131          xx(i) = -0.0001
    132132        else
    133133         zx1=-sqrt2*vmax(i)
    134          zx2=SQRT(1.0+delta(i)/(vmax(i)**2.))
    135          xx1(i)=zx1*(1.0-zx2)
    136          xx2(i)=zx1*(1.0+zx2)
    137          xx(i) = 1.01 * xx1(i)
    138          if ( xx1(i) .GE. 0.0 ) xx(i) = 0.5*xx2(i)
     134         zx2=SQRT(1.0+delta(i)/(vmax(i)*vmax(i)))
     135         xx1=zx1*(1.0-zx2)
     136         xx2=zx1*(1.0+zx2)
     137         xx(i) = 1.01 * xx1
     138         if ( xx1 .GE. 0.0 ) xx(i) = 0.5*xx2
    139139        endif
    140         if (delta(i).LT.0.) xx(i) = -0.5*SQRT(log(2.))
     140        if (delta(i).LT.0.) xx(i) = -hsqrtlog_2
    141141
    142142      ENDIF
    … …  
    153153        if (.not.lconv(i)) then
    154154
    155           u(i) = delta(i)/(xx(i)*sqrt2) + xx(i)/(2.*sqrt2)
    156           v(i) = delta(i)/(xx(i)*sqrt2) - xx(i)/(2.*sqrt2)
    157 
    158           IF ( v(i) .GT. vmax(i) ) THEN
    159 
    160             IF (     ABS(u(i))  .GT. vmax(i)
     155          u = delta(i)/(xx(i)*sqrt2) + xx(i)/(2.*sqrt2)
     156          v = delta(i)/(xx(i)*sqrt2) - xx(i)/(2.*sqrt2)
     157          v2 = v*v
     158
     159          IF ( v .GT. vmax(i) ) THEN
     160
     161            IF (     ABS(u)  .GT. vmax(i)
    161162     :          .AND.  delta(i) .LT. 0. ) THEN
    162163
    … …  
    171172             endif
    172173             xx(i) = -SQRT(aux(i))
    173              block(i) = EXP(-v(i)*v(i)) / v(i) / sqrtpi
    174              dist(i) = 0.0
    175              fprime(i) = 1.0
     174             block = EXP(-v*v) / v / sqrtpi
     175             dist = 0.0
     176             fprime = 1.0
    176177
    177178            ELSE
    … …  
    179180c -- erfv -> 1.0, use an asymptotic expression of erfv for v large:
    180181
    181              erfcu(i) = 1.0-ERF(u(i))
     182             erfcu = 1.0-ERF(u)
    182183c  !!! ATTENTION : rajout d'un seuil pour l'exponentiel
    183              aux(i) = sqrtpi*erfcu(i)*EXP(min(v(i)*v(i),100.))
    184              coeff(i) = 1.0 - 1./2./(v(i)**2.) + 3./4./(v(i)**4.)
    185              block(i) = coeff(i) * EXP(-v(i)*v(i)) / v(i) / sqrtpi
    186              dist(i) = v(i) * aux(i) / coeff(i) - beta(i)
    187              fprime(i) = 2.0 / xx(i) * (v(i)**2.)
    188      :           * ( coeff(i)*EXP(-delta(i)) - u(i) * aux(i) )
    189      :           / coeff(i) / coeff(i)
     184             aux(i) = sqrtpi*erfcu*EXP(min(v2,100.))
     185             coeff = 1.0 - 0.5/(v2) + 0.75/(v2*v2)
     186             block = coeff * EXP(-v2) / v / sqrtpi
     187             dist = v * aux(i) / coeff - beta(i)
     188             fprime = 2.0 / xx(i) * (v2)
     189     :           * ( EXP(-delta(i)) - u * aux(i) / coeff )
     190     :           / coeff
    190191           
    191192            ENDIF ! ABS(u)
    … …  
    195196c -- general case:
    196197
    197            erfcu(i) = 1.0-ERF(u(i))
    198            erfcv(i) = 1.0-ERF(v(i))
    199            block(i) = erfcv(i)
    200            dist(i) = erfcu(i) / erfcv(i) - beta(i)
    201            zu2(i)=u(i)*u(i)
    202            zv2(i)=v(i)*v(i)
    203            if(zu2(i).gt.20..or. zv2(i).gt.20.) then
     198           erfcu = 1.0-ERF(u)
     199           erfcv = 1.0-ERF(v)
     200           block = erfcv
     201           dist = erfcu / erfcv - beta(i)
     202           zu2=u*u
     203           zv2=v2
     204           if(zu2.gt.20..or. zv2.gt.20.) then
    204205c              print*,'ATTENTION !!! xx(',i,') =', xx(i)
    205206c           print*,'ATTENTION !!! klon,ND,R,RS,QSUB,PTCONV,RATQSC,CLDF',
    … …  
    207208c     .CLDF(i,k)
    208209c              print*,'ATTENTION !!! zu2 zv2 =',zu2(i),zv2(i)
    209               zu2(i)=20.
    210               zv2(i)=20.
    211              fprime(i) = 0.
     210              zu2=20.
     211              zv2=20.
     212             fprime = 0.
    212213           else
    213              fprime(i) = 2. /sqrtpi /xx(i) /erfcv(i)**2.
    214      :           * (   erfcv(i)*v(i)*EXP(-zu2(i))
    215      :               - erfcu(i)*u(i)*EXP(-zv2(i)) )
     214             fprime = 2. /sqrtpi /xx(i) /(erfcv*erfcv)
     215     :           * (   erfcv*v*EXP(-zu2)
     216     :               - erfcu*u*EXP(-zv2) )
    216217           endif
    217218          ENDIF ! x
    … …  
    223224!              stop
    224225!          endif
    225           if (abs(fprime(i)).lt.1.e-11) then
     226          if (abs(fprime).lt.1.e-11) then
    226227!              print*,'avant test fprime<.e-11 '
    227228!     s        ,i,k,lconv(i),u(i),v(i),beta(i),fprime(i)
    228229!              print*,'klon,ND,R,RS,QSUB',
    229230!     s        klon,ND,R(i,k),rs(i,k),qsub(i,k)
    230               fprime(i)=sign(1.e-11,fprime(i))
     231              fprime=sign(1.e-11,fprime)
    231232          endif
    232233
    233234
    234           if ( ABS(dist(i)/beta(i)) .LT. epsilon ) then
     235          if ( ABS(dist/beta(i)) .LT. epsilon ) then
    235236c           print*,'v-u **2',(v(i)-u(i))**2
    236237c           print*,'exp v-u **2',exp((v(i)-u(i))**2)
    … …  
    238239            lconv(i)=.true.
    239240c  borne pour l'exponentielle
    240             ratqsc(i,k)=min(2.*(v(i)-u(i))**2,20.)
     241            ratqsc(i,k)=min(2.*(v-u)*(v-u),20.)
    241242            ratqsc(i,k)=sqrt(exp(ratqsc(i,k))-1.)
    242             CLDF(i,K) = 0.5 * block(i)
     243            CLDF(i,K) = 0.5 * block
    243244          else
    244             xx(i) = xx(i) - dist(i)/fprime(i)
     245            xx(i) = xx(i) - dist/fprime
    245246          endif
    246247c         print*,'apres test ',i,k,lconv(i)

  • LMDZ4/trunk/libf/phylmd/conf_phys.F90

    r1146 r1279  
    11
    22!
    3 ! $Header$
    4 !
    5 !
    6 !
     3! $Id$
     4!
     5!
     6!
     7module conf_phys_m
     8
     9   implicit none
     10
     11contains
    712
    813  subroutine conf_phys(ok_journe, ok_mensuel, ok_instan, ok_hf, &
    9  &                     ok_LES,&
    10  &                     solarlong0,seuil_inversion, &
    11  &                     fact_cldcon, facttemps,ok_newmicro,iflag_radia,&
    12  &                     iflag_cldcon, &
    13  &                     iflag_ratqs,ratqsbas,ratqshaut, &
    14  &                     ok_ade, ok_aie, aerosol_couple, &
    15  &                     bl95_b0, bl95_b1,&
    16  &                     iflag_thermals,nsplit_thermals,tau_thermals, &
    17  &                     iflag_thermals_ed,iflag_thermals_optflux, &
    18  &                     iflag_coupl,iflag_clos,iflag_wake )
     14                       ok_LES,&
     15                       solarlong0,seuil_inversion, &
     16                       fact_cldcon, facttemps,ok_newmicro,iflag_radia,&
     17                       iflag_cldcon, &
     18                       iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
     19                       ok_ade, ok_aie, aerosol_couple, &
     20                       flag_aerosol, new_aod, &
     21                       bl95_b0, bl95_b1,&
     22                       iflag_thermals,nsplit_thermals,tau_thermals, &
     23                       iflag_thermals_ed,iflag_thermals_optflux, &
     24                       iflag_coupl,iflag_clos,iflag_wake, read_climoz)
    1925
    2026   use IOIPSL
    2127   USE surface_data
    22 
    23    implicit none
     28   USE carbon_cycle_mod, ONLY : carbon_cycle_tr, carbon_cycle_cpl
    2429
    2530 include "conema3.h"
    … …  
    6065  logical              :: ok_LES
    6166  LOGICAL              :: ok_ade, ok_aie, aerosol_couple
     67  INTEGER              :: flag_aerosol
     68  LOGICAL              :: new_aod
    6269  REAL                 :: bl95_b0, bl95_b1
    63   real                 :: fact_cldcon, facttemps,ratqsbas,ratqshaut
     70  real                 :: fact_cldcon, facttemps,ratqsbas,ratqshaut,tau_ratqs
    6471  integer              :: iflag_cldcon
    6572  integer              :: iflag_ratqs
    … …  
    7178  logical,SAVE        :: ok_LES_omp   
    7279  LOGICAL,SAVE        :: ok_ade_omp, ok_aie_omp, aerosol_couple_omp
     80  INTEGER, SAVE       :: flag_aerosol_omp
     81  LOGICAL, SAVE       :: new_aod_omp
    7382  REAL,SAVE           :: bl95_b0_omp, bl95_b1_omp
    7483  REAL,SAVE           :: freq_ISCCP_omp, ecrit_ISCCP_omp
     84  REAL,SAVE           :: freq_COSP_omp
    7585  real,SAVE           :: fact_cldcon_omp, facttemps_omp,ratqsbas_omp
    7686  real,SAVE           :: ratqshaut_omp
     87  real,SAVE           :: tau_ratqs_omp
    7788  integer,SAVE        :: iflag_radia_omp
    7889  integer,SAVE        :: iflag_rrtm_omp
    7990  integer,SAVE        :: iflag_cldcon_omp, ip_ebil_phy_omp
    8091  integer,SAVE        :: iflag_ratqs_omp
     92
     93  Real,SAVE           :: f_cdrag_ter_omp,f_cdrag_oce_omp
     94  Real,SAVE           :: f_rugoro_omp   
    8195
    8296! Local
    … …  
    121135  REAL, SAVE ::  fmagic_omp, pmagic_omp
    122136  INTEGER,SAVE :: iflag_pbl_omp,lev_histhf_omp,lev_histday_omp,lev_histmth_omp
     137  Integer,save :: lev_histins_omp, lev_histLES_omp
    123138  CHARACTER*4, SAVE :: type_run_omp
    124139  LOGICAL,SAVE :: ok_isccp_omp
     140  LOGICAL,SAVE :: ok_cosp_omp
    125141  REAL,SAVE :: lonmin_ins_omp, lonmax_ins_omp, latmin_ins_omp, latmax_ins_omp
    126142  REAL,SAVE :: ecrit_hf_omp, ecrit_day_omp, ecrit_mth_omp, ecrit_reg_omp
     143  REAL,SAVE :: ecrit_ins_omp
    127144  REAL,SAVE :: ecrit_LES_omp
    128145  REAL,SAVE :: ecrit_tra_omp
    … …  
    135152  LOGICAL,SAVE :: ok_strato_omp
    136153  LOGICAL,SAVE :: ok_hines_omp
    137 !
     154  LOGICAL,SAVE      :: carbon_cycle_tr_omp
     155  LOGICAL,SAVE      :: carbon_cycle_cpl_omp
     156
     157  integer, intent(out):: read_climoz ! read ozone climatology, OpenMP shared
     158  ! Allowed values are 0, 1 and 2
     159  ! 0: do not read an ozone climatology
     160  ! 1: read a single ozone climatology that will be used day and night
     161  ! 2: read two ozone climatologies, the average day and night
     162  ! climatology and the daylight climatology
    138163
    139164!$OMP MASTER
    … …  
    239264  CALL getin('aerosol_couple',aerosol_couple_omp)
    240265
     266!
     267!Config Key  = flag_aerosol
     268!Config Desc = which aerosol is use for coupled model
     269!Config Def  = 1
     270!Config Help = Used in physiq.F
     271!
     272! - flag_aerosol=1 => so4 only (defaut)
     273! - flag_aerosol=2 => bc  only
     274! - flag_aerosol=3 => pom only
     275! - flag_aerosol=4 => seasalt only
     276! - flag_aerosol=5 => dust only
     277! - flag_aerosol=6 => all aerosol
     278
     279  flag_aerosol_omp = 1
     280  CALL getin('flag_aerosol',flag_aerosol_omp)
     281
     282! Temporary variable for testing purpose!!
     283!Config Key  = new_aod
     284!Config Desc = which calcul of aeropt
     285!Config Def  = false
     286!Config Help = Used in physiq.F
     287!
     288  new_aod_omp = .true.
     289  CALL getin('new_aod',new_aod_omp)
     290
    241291!
    242292!Config Key  = aer_type
    243293!Config Desc = Use a constant field for the aerosols
    244294!Config Def  = scenario
    245 !Config Help = Used in readsulfate.F
     295!Config Help = Used in readaerosol.F90
    246296!
    247297  aer_type_omp = 'scenario'
    … …  
    283333  ecrit_ISCCP_omp = 1.
    284334  call getin('ecrit_ISCCP', ecrit_ISCCP_omp)
     335
     336!Config Key  = freq_COSP
     337!Config Desc = Frequence d'appel du simulateur COSP en secondes;
     338!              par defaut 10800, i.e. 3 heures
     339!Config Def  = 10800.
     340!Config Help = Used in ini_histdayCOSP.h
     341!
     342  freq_COSP_omp = 10800.
     343  call getin('freq_COSP', freq_COSP_omp)
     344
    285345!
    286346!Config Key  = ip_ebil_phy
    … …  
    690750  call getin('ratqshaut',ratqshaut_omp)
    691751
     752!Config Key  = tau_ratqs
     753!Config Desc = 
     754!Config Def  = 1800.
     755!Config Help =
     756!
     757  tau_ratqs_omp = 1800.
     758  call getin('tau_ratqs',tau_ratqs_omp)
     759
    692760!
    693761!-----------------------------------------------------------------------
    … …  
    918986!Config Help =
    919987!
    920   iflag_coupl = 0
     988  iflag_coupl_omp = 0
    921989  call getin('iflag_coupl',iflag_coupl_omp)
    922990
    … …  
    927995!Config Help =
    928996!
    929   iflag_clos = 1
     997  iflag_clos_omp = 1
    930998  call getin('iflag_clos',iflag_clos_omp)
    931999!
    … …  
    9351003!Config Help =
    9361004!
    937   iflag_cvl_sigd = 0
     1005  iflag_cvl_sigd_omp = 0
    9381006  call getin('iflag_cvl_sigd',iflag_cvl_sigd_omp)
    9391007
    … …  
    9431011!Config Help =
    9441012!
    945   iflag_wake = 0
     1013  iflag_wake_omp = 0
    9461014  call getin('iflag_wake',iflag_wake_omp)
    9471015
    … …  
    9721040  lev_histmth_omp = 2
    9731041  call getin('lev_histmth',lev_histmth_omp)
    974 
     1042!
     1043!Config Key  = lev_histins
     1044!Config Desc =
     1045!Config Def  = 1
     1046!Config Help =
     1047!
     1048  lev_histins_omp = 1
     1049  call getin('lev_histins',lev_histins_omp)
     1050  !
     1051!Config Key  = lev_histLES
     1052!Config Desc =
     1053!Config Def  = 1
     1054!Config Help =
     1055!
     1056  lev_histLES_omp = 1
     1057  call getin('lev_histLES',lev_histLES_omp)
    9751058  !
    9761059!Config Key  = type_run
    … …  
    9931076
    9941077!
     1078!Config Key  = ok_cosp
     1079!Config Desc =
     1080!Config Def  = .false.
     1081!Config Help =
     1082!
     1083  ok_cosp_omp = .false.
     1084  call getin('ok_cosp',ok_cosp_omp)
     1085
     1086!
    9951087! coordonnees (lonmin_ins, lonmax_ins, latmin_ins, latmax_ins) pour la zone
    9961088! avec sorties instantannees tous les pas de temps de la physique => "histbilKP_ins.nc"
    … …  
    10361128  call getin('ecrit_hf',ecrit_hf_omp)
    10371129!
     1130!Config Key  = ecrit_ins
     1131!Config Desc =
     1132!Config Def  = 1./48. ! toutes les 1/2 h
     1133!Config Help =
     1134!
     1135  ecrit_ins_omp = 1./48.
     1136  call getin('ecrit_ins',ecrit_ins_omp)
     1137!
    10381138!Config Key  = ecrit_day
    10391139!Config Desc =
    … …  
    10701170!
    10711171!
     1172! PARAMETRES CDRAG
     1173!
     1174!Config Key  = f_cdrag_ter
     1175!Config Desc =
     1176!Config Def  = 0.8
     1177!Config Help =
     1178!
     1179  f_cdrag_ter_omp = 0.8
     1180  call getin('f_cdrag_ter',f_cdrag_ter_omp)
     1181!
     1182!Config Key  = f_cdrag_oce
     1183!Config Desc =
     1184!Config Def  = 0.8
     1185!Config Help =
     1186!
     1187  f_cdrag_oce_omp = 0.8
     1188  call getin('f_cdrag_oce',f_cdrag_oce_omp)
     1189!
     1190! RUGORO
     1191!Config Key  = f_rugoro
     1192!Config Desc =
     1193!Config Def  = 0.
     1194!Config Help =
     1195!
     1196  f_rugoro_omp = 0.
     1197  call getin('f_rugoro',f_rugoro_omp)
     1198
    10721199! PARAMETERS FOR CONVECTIVE INHIBITION BY TROPOS. DRYNESS
    10731200!
    … …  
    11911318  call getin('ecrit_LES', ecrit_LES_omp)
    11921319!
     1320  read_climoz = 0 ! default value
     1321  call getin('read_climoz', read_climoz)
     1322
     1323  carbon_cycle_tr_omp=.FALSE.
     1324  CALL getin('carbon_cycle_tr',carbon_cycle_tr_omp)
     1325
     1326  carbon_cycle_cpl_omp=.FALSE.
     1327  CALL getin('carbon_cycle_cpl',carbon_cycle_cpl_omp)
    11931328
    11941329!$OMP END MASTER
    … …  
    12521387    lev_histday = lev_histday_omp
    12531388    lev_histmth = lev_histmth_omp
     1389    lev_histins = lev_histins_omp
     1390    lev_histLES = lev_histLES_omp
    12541391
    12551392    type_ocean = type_ocean_omp
    … …  
    12631400    freq_ISCCP = freq_ISCCP_omp
    12641401    ecrit_ISCCP = ecrit_ISCCP_omp
     1402    freq_COSP = freq_COSP_omp
    12651403    ok_ade = ok_ade_omp
    12661404    ok_aie = ok_aie_omp
    12671405    aerosol_couple = aerosol_couple_omp
     1406    flag_aerosol=flag_aerosol_omp
     1407    new_aod=new_aod_omp
    12681408    aer_type = aer_type_omp
    12691409    bl95_b0 = bl95_b0_omp
    … …  
    12731413    ratqsbas = ratqsbas_omp
    12741414    ratqshaut = ratqshaut_omp
     1415    tau_ratqs = tau_ratqs_omp
     1416
    12751417    iflag_radia = iflag_radia_omp
    12761418    iflag_rrtm = iflag_rrtm_omp
    … …  
    12891431    type_run = type_run_omp
    12901432    ok_isccp = ok_isccp_omp
     1433    ok_cosp = ok_cosp_omp
    12911434    seuil_inversion=seuil_inversion_omp
    12921435    lonmin_ins = lonmin_ins_omp
    … …  
    12951438    latmax_ins = latmax_ins_omp
    12961439    ecrit_hf   = ecrit_hf_omp
     1440    ecrit_ins   = ecrit_ins_omp
    12971441    ecrit_day = ecrit_day_omp
    12981442    ecrit_mth = ecrit_mth_omp
    … …  
    13011445    cvl_corr = cvl_corr_omp
    13021446    ok_lic_melt = ok_lic_melt_omp
     1447    f_cdrag_ter=f_cdrag_ter_omp
     1448    f_cdrag_oce=f_cdrag_oce_omp
     1449    f_rugoro=f_rugoro_omp
    13031450    supcrit1 = supcrit1_omp
    13041451    supcrit2 = supcrit2_omp
    … …  
    13141461    ok_LES = ok_LES_omp
    13151462    ecrit_LES = ecrit_LES_omp
    1316    
     1463    carbon_cycle_tr = carbon_cycle_tr_omp
     1464    carbon_cycle_cpl = carbon_cycle_cpl_omp
     1465
    13171466! Test of coherence between type_ocean and version_ocean
    13181467    IF (type_ocean=='couple' .AND. (version_ocean/='opa8' .AND. version_ocean/='nemo') ) THEN
    … …  
    13261475       WRITE(numout,*)' ERROR version_ocean=',version_ocean,' not valid with slab ocean'
    13271476       CALL abort_gcm('conf_phys','version_ocean not valid',1)
     1477    END IF
     1478
     1479! Test sur new_aod. Ce flag permet de retrouver les resultats de l'AR4
     1480! il n'est utilisable que lors du couplage avec le SO4 seul
     1481    IF (ok_ade .OR. ok_aie) THEN
     1482       IF ( .NOT. new_aod .AND.  flag_aerosol .NE. 1) THEN
     1483          CALL abort_gcm('conf_phys','new_aod=.FALSE. not compatible avec flag_aerosol=1',1)
     1484       END IF
    13281485    END IF
    13291486
    … …  
    13411498  write(numout,*)' Frequence appel simulateur ISCCP, freq_ISCCP =', freq_ISCCP
    13421499  write(numout,*)' Frequence appel simulateur ISCCP, ecrit_ISCCP =', ecrit_ISCCP
     1500  write(numout,*)' Frequence appel simulateur COSP, freq_COSP =', freq_COSP
    13431501  write(numout,*)' Sortie bilan d''energie, ip_ebil_phy =', ip_ebil_phy
    13441502  write(numout,*)' Excentricite = ',R_ecc
    … …  
    13841542  write(numout,*)' ratqsbas = ',ratqsbas
    13851543  write(numout,*)' ratqshaut = ',ratqshaut
     1544  write(numout,*)' tau_ratqs = ',tau_ratqs
    13861545  write(numout,*)' top_height = ',top_height
    13871546  write(numout,*)' overlap = ',overlap
    … …  
    13961555  write(numout,*)' ok_aie = ',ok_aie
    13971556  write(numout,*)' aerosol_couple = ', aerosol_couple
     1557  write(numout,*)' flag_aerosol = ', flag_aerosol
     1558  write(numout,*)' new_aod = ', new_aod
    13981559  write(numout,*)' aer_type = ',aer_type
    13991560  write(numout,*)' bl95_b0 = ',bl95_b0
    … …  
    14021563  write(numout,*)' lev_histday = ',lev_histday
    14031564  write(numout,*)' lev_histmth = ',lev_histmth
     1565  write(numout,*)' lev_histins = ',lev_histins
     1566  write(numout,*)' lev_histLES = ',lev_histLES
    14041567  write(numout,*)' iflag_pbl = ', iflag_pbl
    14051568  write(numout,*)' iflag_thermals = ', iflag_thermals
    … …  
    14091572  write(numout,*)' type_run = ',type_run
    14101573  write(numout,*)' ok_isccp = ',ok_isccp
    1411   WRITE(numout,*)' solarlong0 = ', solarlong0
     1574  write(numout,*)' ok_cosp = ',ok_cosp
     1575  write(numout,*)' solarlong0 = ', solarlong0
    14121576  write(numout,*)' qsol0 = ', qsol0
    14131577  write(numout,*)' inertie_sol = ', inertie_sol
    14141578  write(numout,*)' inertie_ice = ', inertie_ice
    14151579  write(numout,*)' inertie_sno = ', inertie_sno
     1580  write(numout,*)' f_cdrag_ter = ',f_cdrag_ter
     1581  write(numout,*)' f_cdrag_oce = ',f_cdrag_oce
     1582  write(numout,*)' f_rugoro = ',f_rugoro
    14161583  write(numout,*)' supcrit1 = ', supcrit1
    14171584  write(numout,*)' supcrit2 = ', supcrit2
    … …  
    14251592
    14261593  write(numout,*)' lonmin lonmax latmin latmax bilKP_ins =',&
    1427  & lonmin_ins, lonmax_ins, latmin_ins, latmax_ins
    1428   write(numout,*)' ecrit_ hf, day, mth, reg, tra, ISCCP, LES',&
    1429  & ecrit_hf, ecrit_day, ecrit_mth, ecrit_reg, ecrit_tra, ecrit_ISCCP, ecrit_LES
     1594   lonmin_ins, lonmax_ins, latmin_ins, latmax_ins
     1595  write(numout,*)' ecrit_ hf, ins, day, mth, reg, tra, ISCCP, LES',&
     1596   ecrit_hf, ecrit_ins, ecrit_day, ecrit_mth, ecrit_reg, ecrit_tra, ecrit_ISCCP, ecrit_LES
    14301597
    14311598  write(numout,*) 'ok_strato = ', ok_strato
    14321599  write(numout,*) 'ok_hines = ',  ok_hines
     1600  write(numout,*) 'read_climoz = ', read_climoz
     1601  write(numout,*) 'carbon_cycle_tr = ', carbon_cycle_tr
     1602  write(numout,*) 'carbon_cycle_cpl = ', carbon_cycle_cpl
    14331603 
    14341604!$OMP END MASTER
    … …  
    14381608  end subroutine conf_phys
    14391609
     1610end module conf_phys_m
    14401611!
    14411612!#################################################################

  • LMDZ4/trunk/libf/phylmd/cpl_mod.F90

    r1146 r1279  
    3939!*************************************************************************************
    4040! variable for coupling period
    41   INTEGER, SAVE                             :: nexca
     41  INTEGER, SAVE :: nexca
    4242  !$OMP THREADPRIVATE(nexca)
    4343
    … …  
    4747  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_snow, cpl_evap, cpl_tsol
    4848  !$OMP THREADPRIVATE(cpl_snow,cpl_evap,cpl_tsol)
    49   REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_fder, cpl_albe, cpl_taux
    50   !$OMP THREADPRIVATE(cpl_fder,cpl_albe,cpl_taux)
     49  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_fder, cpl_albe, cpl_taux, cpl_tauy
     50  !$OMP THREADPRIVATE(cpl_fder,cpl_albe,cpl_taux,cpl_tauy)
    5151  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_windsp
    5252  !$OMP THREADPRIVATE(cpl_windsp)
    53   REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_tauy
    54   !$OMP THREADPRIVATE(cpl_tauy)
     53  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_taumod
     54  !$OMP THREADPRIVATE(cpl_taumod)
     55  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_atm_co2
     56  !$OMP THREADPRIVATE(cpl_atm_co2)
    5557  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_rriv2D, cpl_rcoa2D, cpl_rlic2D
    5658  !$OMP THREADPRIVATE(cpl_rriv2D,cpl_rcoa2D,cpl_rlic2D)
    … …  
    6769  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_u0, read_v0 ! ocean surface current
    6870  !$OMP THREADPRIVATE(read_u0,read_v0)
    69  
     71  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_co2     ! ocean co2 flux
     72  !$OMP THREADPRIVATE(read_co2)
    7073  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: unity
    7174  !$OMP THREADPRIVATE(unity)
    … …  
    8285  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_taux2D, cpl_tauy2D
    8386  !$OMP THREADPRIVATE(cpl_taux2D, cpl_tauy2D)
     87  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_taumod2D
     88  !$OMP THREADPRIVATE(cpl_taumod2D)
    8489  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_windsp2D
    8590  !$OMP THREADPRIVATE(cpl_windsp2D)
    86  
    87 ! variable for OPENMP parallelisation
    88 
    89   INTEGER,ALLOCATABLE,DIMENSION(:),SAVE :: knon_omp
    90   REAL,ALLOCATABLE,DIMENSION(:,:),SAVE ::  buffer_omp
    91  
     91  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_atm_co22D
     92  !$OMP THREADPRIVATE(cpl_atm_co22D)
     93
    9294CONTAINS
    9395!
    … …  
    9597!
    9698  SUBROUTINE cpl_init(dtime, rlon, rlat)
     99    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day
    97100
    98101    INCLUDE "dimensions.h"
    … …  
    160163    ALLOCATE(cpl_taux(klon,2), stat = error)
    161164    sum_error = sum_error + error
     165    ALLOCATE(cpl_tauy(klon,2), stat = error)
     166    sum_error = sum_error + error
    162167    ALLOCATE(cpl_windsp(klon,2), stat = error)
    163168    sum_error = sum_error + error
    164     ALLOCATE(cpl_tauy(klon,2), stat = error)
     169    ALLOCATE(cpl_taumod(klon,2), stat = error)
    165170    sum_error = sum_error + error
    166171    ALLOCATE(cpl_rriv2D(iim,jj_nb), stat=error)
    … …  
    178183    ALLOCATE(read_alb_sic(iim, jj_nb), stat = error)
    179184    sum_error = sum_error + error
    180 
    181185    ALLOCATE(read_u0(iim, jj_nb), stat = error)
    182186    sum_error = sum_error + error
    183187    ALLOCATE(read_v0(iim, jj_nb), stat = error)
    184188    sum_error = sum_error + error
     189
     190    IF (carbon_cycle_cpl) THEN
     191       ALLOCATE(read_co2(iim, jj_nb), stat = error)
     192       sum_error = sum_error + error
     193       ALLOCATE(cpl_atm_co2(klon,2), stat = error)
     194       sum_error = sum_error + error
     195
     196! Allocate variable in carbon_cycle_mod
     197       ALLOCATE(fco2_ocn_day(klon), stat = error)
     198       sum_error = sum_error + error
     199    END IF
    185200
    186201    IF (sum_error /= 0) THEN
    … …  
    196211    ENDDO
    197212
    198 !    cpl_sols = 0.   ; cpl_nsol = 0.  ; cpl_rain = 0.   ; cpl_snow = 0.
    199 !    cpl_evap = 0.   ; cpl_tsol = 0.  ; cpl_fder = 0.   ; cpl_albe = 0.
    200 !    cpl_taux = 0.   ; cpl_tauy = 0.  ; cpl_rriv2D = 0. ; cpl_rcoa2D = 0.
    201 !    cpl_rlic2D = 0. ; cpl_windsp = 0.
    202 
    203213!*************************************************************************************
    204214! Initialize coupling
    … …  
    207217    idtime = INT(dtime)
    208218#ifdef CPP_COUPLE
    209 !$OMP MASTER   
    210219    CALL inicma
    211 !$OMP END MASTER
    212220#endif
    213221
    … …  
    237245       CALL histdef(nidct, 'tmp_lat','tmp_lat', &
    238246            "-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
    239        DO jf=1,jpflda2o1 + jpflda2o2
    240           CALL histdef(nidct, cl_writ(jf),cl_writ(jf), &
    241                "-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
     247       DO jf=1,maxsend
     248         IF (infosend(i)%action) THEN
     249             CALL histdef(nidct, infosend(i)%name ,infosend(i)%name , &
     250                "-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
     251         ENDIF
    242252       END DO
    243253       CALL histend(nidct)
    … …  
    248258            0,zjulian,dtime,nhoridcs,nidcs)
    249259! no vertical axis
    250        DO jf=1,jpfldo2a
    251           CALL histdef(nidcs, cl_read(jf),cl_read(jf), &
    252                "-",iim, jjm+1, nhoridcs, 1, 1, 1, -99, 32, "inst", dtime,dtime)
     260       DO jf=1,maxrecv
     261         IF (inforecv(i)%action) THEN
     262             CALL histdef(nidcs,inforecv(i)%name ,inforecv(i)%name , &
     263                "-",iim, jjm+1, nhoridcs, 1, 1, 1, -99, 32, "inst", dtime,dtime)
     264         ENDIF
    253265       END DO
    254266       CALL histend(nidcs)
    … …  
    256268
    257269    ENDIF    ! is_sequential
    258    
    259 ! OPENMP Initialization
    260 
    261 !$OMP MASTER
    262   ALLOCATE(knon_omp(0:omp_size-1))
    263   ALLOCATE(buffer_omp(klon_mpi,0:omp_size-1))       
    264 !$OMP END MASTER
    265 !$OMP BARRIER
    266270   
    267271  END SUBROUTINE cpl_init
    … …  
    278282    USE surface_data
    279283    USE phys_state_var_mod, ONLY : rlon, rlat
    280 
     284    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
     285   
    281286    INCLUDE "indicesol.h"
    282287    INCLUDE "temps.h"
    … …  
    300305    CHARACTER(len = 80)                     :: abort_message
    301306    REAL, DIMENSION(klon)                   :: read_sic1D
    302     REAL, DIMENSION(iim,jj_nb,jpfldo2a)     :: tab_read_flds
     307    REAL, DIMENSION(iim,jj_nb,maxrecv)      :: tab_read_flds
    303308    REAL, DIMENSION(klon,nbsrf)             :: pctsrf_old
    304309    REAL, DIMENSION(klon_mpi)               :: rlon_mpi, rlat_mpi
    … …  
    314319    is_modified=.FALSE.
    315320
    316 ! Check if right moment to recevie from coupler
     321! Check if right moment to receive from coupler
    317322    IF (MOD(itime, nexca) == 1) THEN
    318323       is_modified=.TRUE.
    … …  
    329334          ndexcs(:) = 0
    330335          itau_w = itau_phy + itime
    331           DO i = 1, jpfldo2a
    332              CALL histwrite(nidcs,cl_read(i),itau_w,tab_read_flds(:,:,i),iim*(jjm+1),ndexcs)
     336          DO i = 1, maxrecv
     337            IF (inforecv(i)%action) THEN
     338                CALL histwrite(nidcs,inforecv(i)%name,itau_w,tab_read_flds(:,:,i),iim*(jjm+1),ndexcs)
     339            ENDIF
    333340          END DO
    334341       ENDIF
    … …  
    337344! Save each field in a 2D array.
    338345!$OMP MASTER
    339        read_sst(:,:)     = tab_read_flds(:,:,1)  ! Sea surface temperature
    340        read_sic(:,:)     = tab_read_flds(:,:,2)  ! Sea ice concentration
    341        read_alb_sic(:,:) = tab_read_flds(:,:,3)  ! Albedo at sea ice
    342        read_sit(:,:)     = tab_read_flds(:,:,4)  ! Sea ice temperature
     346       read_sst(:,:)     = tab_read_flds(:,:,idr_sisutw)  ! Sea surface temperature
     347       read_sic(:,:)     = tab_read_flds(:,:,idr_icecov)  ! Sea ice concentration
     348       read_alb_sic(:,:) = tab_read_flds(:,:,idr_icealw)  ! Albedo at sea ice
     349       read_sit(:,:)     = tab_read_flds(:,:,idr_icetem)  ! Sea ice temperature
    343350!$OMP END MASTER
    344351
    … …  
    354361! Transform the currents from cartesian to spheric coordinates
    355362! tmp_r0 should be zero
    356           CALL geo2atm(iim, jj_nb, tab_read_flds(:,:,5), tab_read_flds(:,:,6), tab_read_flds(:,:,7), &
     363          CALL geo2atm(iim, jj_nb, tab_read_flds(:,:,idr_curenx), &
     364             tab_read_flds(:,:,idr_cureny), tab_read_flds(:,:,idr_curenz), &
    357365               tmp_lon, tmp_lat, &
    358366               read_u0(:,:), read_v0(:,:), tmp_r0(:,:))
    359367!$OMP END MASTER
    360368
    361        ELSE
     369      ELSE
    362370          read_u0(:,:) = 0.
    363371          read_v0(:,:) = 0.
     372      ENDIF
     373
     374       IF (carbon_cycle_cpl) THEN
     375!$OMP MASTER
     376           read_co2(:,:) = tab_read_flds(:,:,idr_oceco2) ! CO2 flux
     377!$OMP END MASTER
    364378       ENDIF
    365379
    … …  
    374388       DO i = 1, klon
    375389          ! treatment only of points with ocean and/or seaice
     390          ! old land-ocean mask can not be changed
    376391          IF (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic) > 0.) THEN
    377392             pctsrf(i,is_sic) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) &
    … …  
    396411! The temperature is transformed into 1D array with valid points from index 1 to knon.
    397412!
     413    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day
    398414    INCLUDE "indicesol.h"
    399415
    … …  
    411427! Local variables
    412428!*************************************************************************************
    413     INTEGER               :: i
    414     REAL, DIMENSION(klon) :: sic_new
     429    INTEGER                  :: i
     430    INTEGER, DIMENSION(klon) :: index
     431    REAL, DIMENSION(klon)    :: sic_new
    415432
    416433!*************************************************************************************
    … …  
    422439    CALL cpl2gath(read_u0, u0_new, knon, knindex)
    423440    CALL cpl2gath(read_v0, v0_new, knon, knindex)
     441
     442!*************************************************************************************
     443! Transform read_co2 into uncompressed 1D variable fco2_ocn_day added directly in
     444! the module carbon_cycle_mod
     445!
     446!*************************************************************************************
     447    IF (carbon_cycle_cpl) THEN
     448       DO i=1,klon
     449          index(i)=i
     450       END DO
     451       CALL cpl2gath(read_co2, fco2_ocn_day, klon, index)
     452    END IF
    424453
    425454!*************************************************************************************
    … …  
    499528! (it is done in cpl_send_seaice_fields).
    500529!
     530    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
    501531    INCLUDE "indicesol.h"
    502532    INCLUDE "dimensions.h"
    … …  
    543573       cpl_tauy(1:knon,cpl_index) = 0.0
    544574       cpl_windsp(1:knon,cpl_index) = 0.0
     575       cpl_taumod(1:knon,cpl_index) = 0.0
     576       IF (carbon_cycle_cpl) cpl_atm_co2(1:knon,cpl_index) = 0.0
    545577    ENDIF
    546578       
    … …  
    571603            tauy(ig)        / FLOAT(nexca)     
    572604       cpl_windsp(ig,cpl_index) = cpl_windsp(ig,cpl_index) + &
    573             windsp(ig)      / FLOAT(nexca)
    574     ENDDO
     605            windsp(ig)      / FLOAT(nexca)
     606       cpl_taumod(ig,cpl_index) =   cpl_taumod(ig,cpl_index) + &
     607          SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / FLOAT (nexca)
     608
     609       IF (carbon_cycle_cpl) THEN
     610          cpl_atm_co2(ig,cpl_index) = cpl_atm_co2(ig,cpl_index) + &
     611               co2_send(knindex(ig))/ FLOAT(nexca)
     612       END IF
     613     ENDDO
    575614
    576615!*************************************************************************************
    … …  
    606645          ALLOCATE(cpl_windsp2D(iim,jj_nb), stat=error)
    607646          sum_error = sum_error + error
     647          ALLOCATE(cpl_taumod2D(iim,jj_nb,2), stat=error)
     648          sum_error = sum_error + error
    608649         
     650          IF (carbon_cycle_cpl) THEN
     651             ALLOCATE(cpl_atm_co22D(iim,jj_nb), stat=error)
     652             sum_error = sum_error + error
     653          END IF
     654
    609655          IF (sum_error /= 0) THEN
    610656             abort_message='Pb allocation variables couplees pour l''ecriture'
    … …  
    650696            knon, knindex)
    651697
    652     ENDIF
     698       CALL gath2cpl(cpl_taumod(:,cpl_index), cpl_taumod2D(:,:,cpl_index), &
     699            knon, knindex)
     700
     701       IF (carbon_cycle_cpl) &
     702            CALL gath2cpl(cpl_atm_co2(:,cpl_index), cpl_atm_co22D(:,:), knon, knindex)
     703   ENDIF
    653704
    654705  END SUBROUTINE cpl_send_ocean_fields
    … …  
    668719! the coupler.
    669720!
     721    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
    670722    INCLUDE "indicesol.h"
    671723    INCLUDE "dimensions.h"
    … …  
    716768       cpl_taux(1:knon,cpl_index) = 0.0
    717769       cpl_tauy(1:knon,cpl_index) = 0.0
     770       cpl_taumod(1:knon,cpl_index) = 0.0
    718771    ENDIF
    719772       
    … …  
    742795            taux(ig)        / FLOAT(nexca)
    743796       cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + &
    744             tauy(ig)        / FLOAT(nexca)     
     797            tauy(ig)        / FLOAT(nexca)     
     798       cpl_taumod(ig,cpl_index) = cpl_taumod(ig,cpl_index) + &
     799            SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / FLOAT(nexca)
    745800    ENDDO
    746801
    … …  
    775830          ALLOCATE(cpl_windsp2D(iim,jj_nb), stat=error)
    776831          sum_error = sum_error + error
    777          
     832          ALLOCATE(cpl_taumod2D(iim,jj_nb,2), stat=error)
     833          sum_error = sum_error + error
     834
     835          IF (carbon_cycle_cpl) THEN
     836             ALLOCATE(cpl_atm_co22D(iim,jj_nb), stat=error)
     837             sum_error = sum_error + error
     838          END IF
     839
    778840          IF (sum_error /= 0) THEN
    779841             abort_message='Pb allocation variables couplees pour l''ecriture'
    … …  
    819881            knon, knindex)
    820882
     883       CALL gath2cpl(cpl_taumod(:,cpl_index), cpl_taumod2D(:,:,cpl_index), &
     884            knon, knindex)
     885
    821886       ! Send all fields
    822887       CALL cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat)
    … …  
    894959! will be done in cpl_send_seaice_fields.
    895960!
     961
    896962    INCLUDE "dimensions.h"
    897963
    … …  
    9471013!   
    9481014    USE surface_data
     1015    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
    9491016! Some includes
    9501017!*************************************************************************************
    … …  
    9791046    REAL, DIMENSION(iim, jj_nb)                          :: tmp_calv
    9801047! Table with all fields to send to coupler
    981     REAL, DIMENSION(iim, jj_nb, jpflda2o1+jpflda2o2)     :: tab_flds
     1048    REAL, DIMENSION(iim, jj_nb, maxsend)                 :: tab_flds
    9821049    REAL, DIMENSION(klon_mpi)                            :: rlon_mpi, rlat_mpi
    9831050
    … …  
    9981065!*************************************************************************************
    9991066!$OMP MASTER
    1000     tab_flds(:,:,7) = cpl_windsp2D(:,:)
    1001     tab_flds(:,:,8) = cpl_sols2D(:,:,2)
    1002     tab_flds(:,:,10) = cpl_nsol2D(:,:,2)
    1003     tab_flds(:,:,12) = cpl_fder2D(:,:,2)
     1067    tab_flds(:,:,ids_windsp) = cpl_windsp2D(:,:)
     1068    tab_flds(:,:,ids_shfice) = cpl_sols2D(:,:,2)
     1069    tab_flds(:,:,ids_nsfice) = cpl_nsol2D(:,:,2)
     1070    tab_flds(:,:,ids_dflxdt) = cpl_fder2D(:,:,2)
    10041071   
    10051072    IF (version_ocean=='nemo') THEN
    1006        tab_flds(:,:,18) = cpl_rriv2D(:,:) + cpl_rcoa2D(:,:)
     1073       tab_flds(:,:,ids_liqrun) = cpl_rriv2D(:,:) + cpl_rcoa2D(:,:)
     1074       IF (carbon_cycle_cpl) tab_flds(:,:,ids_atmco2)=cpl_atm_co22D(:,:)
    10071075    ELSE IF (version_ocean=='opa8') THEN
    1008        tab_flds(:,:,9) = cpl_sols2D(:,:,1)
    1009        tab_flds(:,:,11) = cpl_nsol2D(:,:,1)
    1010        tab_flds(:,:,13) = cpl_evap2D(:,:,2)
    1011        tab_flds(:,:,14) = cpl_evap2D(:,:,1)
    1012        tab_flds(:,:,17) = cpl_rcoa2D(:,:)
    1013        tab_flds(:,:,18) = cpl_rriv2D(:,:)
     1076       tab_flds(:,:,ids_shfoce) = cpl_sols2D(:,:,1)
     1077       tab_flds(:,:,ids_nsfoce) = cpl_nsol2D(:,:,1)
     1078       tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2)
     1079       tab_flds(:,:,ids_ocevap) = cpl_evap2D(:,:,1)
     1080       tab_flds(:,:,ids_runcoa) = cpl_rcoa2D(:,:)
     1081       tab_flds(:,:,ids_rivflu) = cpl_rriv2D(:,:)
    10141082    END IF
    10151083
    … …  
    10631131      ENDIF
    10641132     
    1065       IF (version_ocean=='nemo') THEN
    1066          tab_flds(:,:,17) = tmp_calv(:,:)
    1067       ELSE IF (version_ocean=='opa8') THEN
    1068          tab_flds(:,:,19) = tmp_calv(:,:)
    1069       END IF
     1133      tab_flds(:,:,ids_calvin) = tmp_calv(:,:)
    10701134
    10711135!*************************************************************************************
    … …  
    10781142
    10791143       IF (version_ocean=='nemo') THEN
    1080           tab_flds(:,:,9)  = 0.0
    1081           tab_flds(:,:,11) = 0.0
    1082           tab_flds(:,:,13) = 0.0
    1083           tab_flds(:,:,14) = 0.0
    1084           tab_flds(:,:,15) = 0.0
     1144          tab_flds(:,:,ids_shftot)  = 0.0
     1145          tab_flds(:,:,ids_nsftot) = 0.0
     1146          tab_flds(:,:,ids_totrai) = 0.0
     1147          tab_flds(:,:,ids_totsno) = 0.0
     1148          tab_flds(:,:,ids_toteva) = 0.0
     1149          tab_flds(:,:,ids_taumod) = 0.0
    10851150 
    10861151          tmp_taux(:,:)    = 0.0
    … …  
    10921157             tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    10931158                  cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1159
     1160             tab_flds(:,:,ids_shftot) = cpl_sols2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1161                  cpl_sols2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1162             tab_flds(:,:,ids_nsftot) = cpl_nsol2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1163                  cpl_nsol2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1164             tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1165                  cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1166             tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1167                  cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1168             tab_flds(:,:,ids_toteva) = cpl_evap2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1169                  cpl_evap2D(:,:,2)  * pctsrf2D(:,:,is_sic) / deno(:,:)
     1170             tab_flds(:,:,ids_taumod) = cpl_taumod2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1171                  cpl_taumod2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    10941172             
    1095              tab_flds(:,:,9) = cpl_sols2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1096                   cpl_sols2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1097              tab_flds(:,:,11) = cpl_nsol2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1098                   cpl_nsol2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1099              tab_flds(:,:,13) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1100                   cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1101              tab_flds(:,:,14) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1102                   cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1103              tab_flds(:,:,15) = cpl_evap2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1104                   cpl_evap2D(:,:,2)  * pctsrf2D(:,:,is_sic) / deno(:,:)
    11051173         ENDWHERE
    11061174
    1107           tab_flds(:,:,16) = cpl_evap2D(:,:,2)
     1175          tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2)
    11081176         
    11091177       ELSE IF (version_ocean=='opa8') THEN
    11101178          ! Store fields for rain and snow in tab_flds(:,:,15) and tab_flds(:,:,16)
    1111           tab_flds(:,:,15) = 0.0
    1112           tab_flds(:,:,16) = 0.0
     1179          tab_flds(:,:,ids_totrai) = 0.0
     1180          tab_flds(:,:,ids_totsno) = 0.0
    11131181          tmp_taux(:,:)    = 0.0
    11141182          tmp_tauy(:,:)    = 0.0
    11151183          ! For all valid grid cells containing some fraction of ocean or sea-ice
    11161184          WHERE ( deno(:,:) /= 0 )
    1117              tab_flds(:,:,15) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1185             tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    11181186                  cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1119              tab_flds(:,:,16) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1187             tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    11201188                  cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    11211189             
    … …  
    11631231!$OMP MASTER
    11641232    CALL atm2geo (iim, jj_nb, tmp_taux, tmp_tauy, tmp_lon, tmp_lat, &
    1165          tab_flds(:,:,1), tab_flds(:,:,2), tab_flds(:,:,3) )
    1166    
    1167     tab_flds(:,:,4)  = tab_flds(:,:,1)
    1168     tab_flds(:,:,5)  = tab_flds(:,:,2)
    1169     tab_flds(:,:,6)  = tab_flds(:,:,3)
     1233         tab_flds(:,:,ids_tauxxu), tab_flds(:,:,ids_tauyyu), tab_flds(:,:,ids_tauzzu) )
     1234   
     1235    tab_flds(:,:,ids_tauxxv)  = tab_flds(:,:,ids_tauxxu)
     1236    tab_flds(:,:,ids_tauyyv)  = tab_flds(:,:,ids_tauyyu)
     1237    tab_flds(:,:,ids_tauzzv)  = tab_flds(:,:,ids_tauzzu)
    11701238!$OMP END MASTER
    11711239
    … …  
    11751243!*************************************************************************************
    11761244    IF (is_sequential) THEN
    1177        CALL histwrite(nidct,cl_writ(8), itau_w,tab_flds(:,:,8), iim*(jjm+1),ndexct)
    1178        CALL histwrite(nidct,cl_writ(9), itau_w,tab_flds(:,:,9), iim*(jjm+1),ndexct)
    1179        CALL histwrite(nidct,cl_writ(10),itau_w,tab_flds(:,:,10),iim*(jjm+1),ndexct)
    1180        CALL histwrite(nidct,cl_writ(11),itau_w,tab_flds(:,:,11),iim*(jjm+1),ndexct)
    1181        CALL histwrite(nidct,cl_writ(12),itau_w,tab_flds(:,:,12),iim*(jjm+1),ndexct)
    1182        CALL histwrite(nidct,cl_writ(13),itau_w,tab_flds(:,:,13),iim*(jjm+1),ndexct)
    1183        CALL histwrite(nidct,cl_writ(14),itau_w,tab_flds(:,:,14),iim*(jjm+1),ndexct)
    1184        CALL histwrite(nidct,cl_writ(15),itau_w,tab_flds(:,:,15),iim*(jjm+1),ndexct)
    1185        CALL histwrite(nidct,cl_writ(16),itau_w,tab_flds(:,:,16),iim*(jjm+1),ndexct)
    1186        CALL histwrite(nidct,cl_writ(17),itau_w,tab_flds(:,:,17),iim*(jjm+1),ndexct)
    1187        CALL histwrite(nidct,cl_writ(18),itau_w,tab_flds(:,:,18),iim*(jjm+1),ndexct)
    1188        CALL histwrite(nidct,cl_writ(19),itau_w,tab_flds(:,:,19),iim*(jjm+1),ndexct)
    1189        CALL histwrite(nidct,cl_writ(1), itau_w,tab_flds(:,:,1), iim*(jjm+1),ndexct)
    1190        CALL histwrite(nidct,cl_writ(2), itau_w,tab_flds(:,:,2), iim*(jjm+1),ndexct)
    1191        CALL histwrite(nidct,cl_writ(3), itau_w,tab_flds(:,:,3), iim*(jjm+1),ndexct)
    1192        CALL histwrite(nidct,cl_writ(4), itau_w,tab_flds(:,:,4), iim*(jjm+1),ndexct)
    1193        CALL histwrite(nidct,cl_writ(5), itau_w,tab_flds(:,:,5), iim*(jjm+1),ndexct)
    1194        CALL histwrite(nidct,cl_writ(6), itau_w,tab_flds(:,:,6), iim*(jjm+1),ndexct)
    1195        CALL histwrite(nidct,cl_writ(7), itau_w,tab_flds(:,:,7), iim*(jjm+1),ndexct)
    1196        CALL histsync(nidct)
     1245        DO j=1,maxsend
     1246          IF (infosend(j)%action) CALL histwrite(nidct,infosend(j)%name, itau_w, &
     1247             tab_flds(:,:,j),iim*(jjm+1),ndexct)
     1248        ENDDO
    11971249    ENDIF
    1198 
    1199 
    12001250!*************************************************************************************
    12011251! Send the table of all fields
    … …  
    12181268    DEALLOCATE(cpl_evap2D, cpl_tsol2D, cpl_fder2D, cpl_albe2D, stat=error )
    12191269    sum_error = sum_error + error
    1220     DEALLOCATE(cpl_taux2D, cpl_tauy2D, cpl_windsp2D, stat=error )
    1221     sum_error = sum_error + error
     1270    DEALLOCATE(cpl_taux2D, cpl_tauy2D, cpl_windsp2D, cpl_taumod2D, stat=error )
     1271    sum_error = sum_error + error
     1272   
     1273    IF (carbon_cycle_cpl) THEN
     1274       DEALLOCATE(cpl_atm_co22D, stat=error )
     1275       sum_error = sum_error + error
     1276    END IF
     1277
    12221278    IF (sum_error /= 0) THEN
    12231279       abort_message='Pb in deallocation of cpl_xxxx2D coupling variables'
    … …  
    12311287  SUBROUTINE cpl2gath(champ_in, champ_out, knon, knindex)
    12321288  USE mod_phys_lmdz_para
    1233 ! Cette routine ecrit un champ 'gathered' sur la grille 2D pour le passer
    1234 ! au coupleur.
     1289! Cette routine transforme un champs de la grille 2D recu du coupleur sur la grille
     1290! 'gathered' (la grille physiq comprime).
    12351291!
    12361292!
    12371293! input:         
    1238 !   champ_in     champ sur la grille gathere       
     1294!   champ_in     champ sur la grille 2D
    12391295!   knon         nombre de points dans le domaine a traiter
    12401296!   knindex      index des points de la surface a traiter
    12411297!
    12421298! output:
    1243 !   champ_out    champ sur la grille 2D
     1299!   champ_out    champ sur la grille 'gatherd'
    12441300!
    12451301    INCLUDE "dimensions.h"

  • LMDZ4/trunk/libf/phylmd/cva_driver.F

    r1146 r1279  
    783783     o                       ,sig,w0,ptop2,cape,cin,m,iflag,coef_clos
    784784     :                       ,Plim1,Plim2,asupmax,supmax0
    785      :                       ,asupmaxmin,cbmf1)
     785     :                       ,asupmaxmin,cbmf)
    786786       ENDIF
    787787      endif   ! iflag_con.eq.3

  • LMDZ4/trunk/libf/phylmd/ecribin.F

    r940 r1279  
    9494      SUBROUTINE ecriture(nunit, r8, n)
    9595      INTEGER nunit, n, i
    96       REAL*8 r8(n)
    97       REAL*4 r4(n)
     96      REAL(KIND=8) r8(n)
     97      REAL r4(n)
    9898      DO i = 1, n
    9999         r4(i) = r8(i)

  • LMDZ4/trunk/libf/phylmd/fisrtilp.F

    r1146 r1279  
    5454      REAL frac_impa(klon,klev)
    5555      REAL frac_nucl(klon,klev)
    56       real zct(klon),zcl(klon)
     56      real zct      ,zcl
    5757cAA
    5858c
    … …  
    8787      REAL ztglace, zt(klon)
    8888      INTEGER nexpo ! exponentiel pour glace/eau
    89       REAL zdz(klon),zrho(klon),ztot(klon), zrhol(klon)
    90       REAL zchau(klon),zfroi(klon),zfice(klon),zneb(klon)
     89      REAL zdz(klon),zrho(klon),ztot      , zrhol(klon)
     90      REAL zchau      ,zfroi      ,zfice(klon),zneb(klon)
    9191c
    9292      LOGICAL appel1er
    … …  
    150150cAA Initialisation a 1 des coefs des fractions lessivees
    151151c
     152!cdir collapse
    152153      DO k = 1, klev
    153154       DO i = 1, klon
    … …  
    161162c
    162163cMAf Initialisation a 0 de zoliq
    163        DO i = 1, klon
    164           zoliq(i)=0.
    165        ENDDO
     164c      DO i = 1, klon
     165c         zoliq(i)=0.
     166c      ENDDO
    166167c Determiner les nuages froids par leur temperature
    167168c  nexpo regle la raideur de la transition eau liquide / eau glace.
    … …  
    173174c Initialiser les sorties:
    174175c
     176!cdir collapse
    175177      DO k = 1, klev+1
    176178      DO i = 1, klon
    … …  
    180182      ENDDO
    181183
     184!cdir collapse
    182185      DO k = 1, klev
    183186      DO i = 1, klon
    … …  
    194197         rain(i) = 0.0
    195198         snow(i) = 0.0
    196       ENDDO
     199         zoliq(i)=0.
     200c     ENDDO
    197201c
    198202c Initialiser le flux de precipitation a zero
    199203c
    200       DO i = 1, klon
     204c     DO i = 1, klon
    201205         zrfl(i) = 0.0
    202206         zneb(i) = seuil_neb
    … …  
    441445         zrhol(i) = zrho(i) * zoliq(i) / zneb(i)
    442446
    443          if (ptconv(i,k)) then
    444             zcl(i)=cld_lc_con
    445             zct(i)=1./cld_tau_con
    446          else
    447             zcl(i)=cld_lc_lsc
    448             zct(i)=1./cld_tau_lsc
    449          endif
    450 c  quantit�d'eau ��minier.
    451          zchau(i) = zct(i)*dtime/FLOAT(ninter) * zoliq(i)
    452      .         *(1.0-EXP(-(zoliq(i)/zneb(i)/zcl(i))**2)) *(1.-zfice(i))
    453 c  meme chose pour la glace.
    454          if (ptconv(i,k)) then
    455             zfroi(i) = dtime/FLOAT(ninter)/zdz(i)*zoliq(i)
     447         IF (zneb(i).EQ.seuil_neb) THEN
     448             ztot = 0.0
     449         ELSE
     450c  quantite d'eau a eliminer: zchau
     451c  meme chose pour la glace: zfroi
     452             if (ptconv(i,k)) then
     453                zcl   =cld_lc_con
     454                zct   =1./cld_tau_con
     455                zfroi    = dtime/FLOAT(ninter)/zdz(i)*zoliq(i)
    456456     .              *fallvc(zrhol(i)) * zfice(i)
    457          else
    458             zfroi(i) = dtime/FLOAT(ninter)/zdz(i)*zoliq(i)
     457             else
     458                zcl   =cld_lc_lsc
     459                zct   =1./cld_tau_lsc
     460                zfroi    = dtime/FLOAT(ninter)/zdz(i)*zoliq(i)
    459461     .              *fallvs(zrhol(i)) * zfice(i)
    460          endif
    461          ztot(i) = zchau(i) + zfroi(i)
    462          IF (zneb(i).EQ.seuil_neb) ztot(i) = 0.0
    463          ztot(i) = MIN(MAX(ztot(i),0.0),zoliq(i))
    464          zoliq(i) = MAX(zoliq(i)-ztot(i), 0.0)
     462             endif
     463             zchau    = zct   *dtime/FLOAT(ninter) * zoliq(i)
     464     .         *(1.0-EXP(-(zoliq(i)/zneb(i)/zcl   )**2)) *(1.-zfice(i))
     465             ztot    = zchau    + zfroi
     466             ztot    = MAX(ztot   ,0.0)
     467         ENDIF
     468         ztot    = MIN(ztot,zoliq(i))
     469         zoliq(i) = MAX(zoliq(i)-ztot   , 0.0)
    465470         radliq(i,k) = radliq(i,k) + zoliq(i)/FLOAT(ninter+1)
    466471      ENDIF

  • LMDZ4/trunk/libf/phylmd/hbtm.F

    r776 r1279  
    762762            endif
    763763c
     764            qsatbef(i) = qqsat    ! bug dans la version orig ???
    764765          endif
    765           qsatbef(i) = qqsat
    766766camn ???? cette ligne a deja ete faite normalement ?
    767767        endif

  • LMDZ4/trunk/libf/phylmd/hgardfou.F

    r1146 r1279  
    11!
     2! $Id$
    23      SUBROUTINE hgardfou (t,tsol,text)
    34      use dimphy
    … …  
    1213      REAL t(klon,klev), tsol(klon,nbsrf)
    1314      CHARACTER*(*) text
     15      character (len=20) :: modname = 'hgardfou'
     16      character (len=80) :: abort_message
    1417C
    1518      INTEGER i, k, nsrf
    … …  
    124127c
    125128      IF (.NOT. ok) THEN
    126          PRINT*, 'hgardfou s arrete ', text
    127          CALL abort
     129         abort_message= 'hgardfou s arrete '//text
     130         CALL abort_gcm (modname,abort_message,1)
    128131      ENDIF
    129132

  • LMDZ4/trunk/libf/phylmd/hines_gwd.F

    r1001 r1279  
     1!
     2! $Id$
     3!
    14      SUBROUTINE HINES_GWD(NLON,NLEV,DTIME,paphm1x, papm1x,
    25     I      rlat,tx,ux,vx,
    … …  
    16661669C  the variances.
    16671670C
    1668       DO 80 N = 1,NAZ
    1669         DO 70 I = IL1,IL2
    1670           IF (I_ALPHA(I,N).LT.0.)  THEN
    1671             WRITE (6,*)
    1672             WRITE (6,*) '******************************'
    1673             WRITE (6,*) 'Hines integral I_ALPHA < 0 '
    1674             WRITE (6,*) '  longitude I=',I
    1675             WRITE (6,*) '  azimuth   N=',N
    1676             WRITE (6,*) '  level   LEV=',LEV
    1677             WRITE (6,*) '  I_ALPHA =',I_ALPHA(I,N)
    1678             WRITE (6,*) '  V_ALPHA =',V_ALPHA(I,LEV,N)
    1679             WRITE (6,*) '  M_ALPHA =',M_ALPHA(I,LEV,N)
    1680             WRITE (6,*) '  Q_ALPHA =',V_ALPHA(I,LEV,N) / BVFB(I)
    1681             WRITE (6,*) '  QM      =',V_ALPHA(I,LEV,N) / BVFB(I)
    1682      ^                                * M_ALPHA(I,LEV,N)
    1683             WRITE (6,*) '******************************'
    1684           END IF
    1685  70     CONTINUE
    1686  80   CONTINUE
     1671c      DO 80 N = 1,NAZ
     1672c        DO 70 I = IL1,IL2
     1673c          IF (I_ALPHA(I,N).LT.0.)  THEN
     1674c            WRITE (6,*)
     1675c            WRITE (6,*) '******************************'
     1676c            WRITE (6,*) 'Hines integral I_ALPHA < 0 '
     1677c            WRITE (6,*) '  longitude I=',I
     1678c            WRITE (6,*) '  azimuth   N=',N
     1679c            WRITE (6,*) '  level   LEV=',LEV
     1680c            WRITE (6,*) '  I_ALPHA =',I_ALPHA(I,N)
     1681c            WRITE (6,*) '  V_ALPHA =',V_ALPHA(I,LEV,N)
     1682c            WRITE (6,*) '  M_ALPHA =',M_ALPHA(I,LEV,N)
     1683c            WRITE (6,*) '  Q_ALPHA =',V_ALPHA(I,LEV,N) / BVFB(I)
     1684c            WRITE (6,*) '  QM      =',V_ALPHA(I,LEV,N) / BVFB(I)
     1685c     ^                                * M_ALPHA(I,LEV,N)
     1686c            WRITE (6,*) '******************************'
     1687c          END IF
     1688c 70     CONTINUE
     1689c 80   CONTINUE
    16871690C
    16881691      RETURN

  • LMDZ4/trunk/libf/phylmd/indicesol.h

    r793 r1279  
    2424      PARAMETER (epsfra=1.0E-05)
    2525!
    26       CHARACTER *3 clnsurf(nbsrf)
     26      CHARACTER(len=3) clnsurf(nbsrf)
    2727      DATA clnsurf/'ter', 'lic', 'oce', 'sic'/
    2828      SAVE clnsurf

  • LMDZ4/trunk/libf/phylmd/ini_histrac.h

    r1146 r1279  
    11!
    2 ! $Header$
     2! $Id $
    33!
    4       IF (ecrit_tra>0. .AND. config_inca == 'none') THEN
    5 c$OMP MASTER
    6          CALL ymds2ju(annee_ref, 1, day_ref, 0.0, zjulian)
    7 c
    8          CALL histbeg_phy("histrac", itau_phy, zjulian, pdtphys,
    9      .                 nhori, nid_tra)
    10          CALL histvert(nid_tra, "presnivs", "Vertical levels", "mb",
    11      .                 klev, presnivs, nvert)
     4  IF (ecrit_tra>0. .AND. config_inca == 'none') THEN
     5!$OMP MASTER
     6     CALL ymds2ju(annee_ref, 1, day_ref, 0.0, zjulian)
     7     CALL histbeg_phy("histrac", itau_phy, zjulian, pdtphys,nhori, nid_tra)
     8     CALL histvert(nid_tra, "presnivs", "Vertical levels", "mb",klev, presnivs, nvert)
    129
     10     zsto = pdtphys
     11     zout = ecrit_tra
     12     CALL histdef(nid_tra, "phis", "Surface geop. height", "-",   &
     13          iim,jj_nb,nhori, 1,1,1, -99, 32,"once",  zsto,zout)
     14     CALL histdef(nid_tra, "aire", "Grid area", "-",              &
     15          iim,jj_nb,nhori, 1,1,1, -99, 32,"once",  zsto,zout)
    1316
     17!TRACEURS
     18!----------------
     19     DO it = 1,nbtr
     20        iiq = niadv(it+2)
    1421
    15          zsto = pdtphys
    16          zout = ecrit_tra
    17 c
    18          CALL histdef(nid_tra, "phis", "Surface geop. height", "-",
    19      .                iim,jj_nb,nhori, 1,1,1, -99, 32,
    20      .                "once",  zsto,zout)
    21 c
    22          CALL histdef(nid_tra, "aire", "Grid area", "-",
    23      .                iim,jj_nb,nhori, 1,1,1, -99, 32,
    24      .                "once",  zsto,zout)
    25          DO it=1,nbtr
    26 C champ 2D
    27          iq=it+2
    28          iiq=niadv(iq)
    29          CALL histdef(nid_tra, tname(iiq), ttext(iiq), "U/kga",
    30      .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    31      .                "ave(X)", zsto,zout)
    32          if (lessivage) THEN
    33          CALL histdef(nid_tra, "fl"//tname(iiq),"Flux "//ttext(iiq),
    34      .              "U/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    35      .              "ave(X)", zsto,zout)
    36          endif
     22! CONCENTRATIONS
     23        CALL histdef(nid_tra, tname(iiq), ttext(iiq), "U/kga",    &
     24             iim,jj_nb,nhori, klev,1,klev,nvert, 32,"ave(X)", zsto,zout)
    3725
    38 c---Ajout Olivia
    39          CALL histdef(nid_tra, "d_tr_th_"//tname(iiq),
    40      .                "tendance thermique"// ttext(iiq), "?",
    41      .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    42      .                "ave(X)", zsto,zout)
    43 c
    44          if(iflag_con.GE.2) then
    45          CALL histdef(nid_tra, "d_tr_cv_"//tname(iiq),
    46      .                "tendance convection"// ttext(iiq), "?",
    47      .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    48      .                "ave(X)", zsto,zout)
    49              endif !(iflag_con.GE.2) then
    50          CALL histdef(nid_tra, "d_tr_cl_"//tname(iiq),
    51      .                "tendance couche limite"// ttext(iiq), "?",
    52      .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    53      .                "ave(X)", zsto,zout)
    54 c---fin Olivia   
     26! TD LESSIVAGE
     27        IF (lessivage .AND. aerosol(it)) THEN
     28           CALL histdef(nid_tra, "fl"//tname(iiq),"Flux "//ttext(iiq), &
     29                "U/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32,       &
     30                "ave(X)", zsto,zout)
     31        END IF
    5532
    56          ENDDO
     33! TD THERMIQUES
     34        IF (iflag_thermals.gt.0) THEN
     35           CALL histdef(nid_tra, "d_tr_th_"//tname(iiq),      &
     36                "tendance thermique"// ttext(iiq), "?",       &
     37                iim,jj_nb,nhori, klev,1,klev,nvert, 32,       &
     38                "ave(X)", zsto,zout)
     39        ENDIF
    5740
    58          CALL histdef(nid_tra, "pyu1", "Vent niv 1", "-",
    59      .                iim,jj_nb,nhori, 1,1,1, -99, 32,
    60      .                "inst(X)",  zout,zout)
     41! TD CONVECTION
     42        IF (iflag_con.GE.2) THEN
     43           CALL histdef(nid_tra, "d_tr_cv_"//tname(iiq),   &
     44                "tendance convection"// ttext(iiq), "?",   &
     45                iim,jj_nb,nhori, klev,1,klev,nvert, 32,    &
     46                "ave(X)", zsto,zout)
     47        ENDIF
    6148
    62          CALL histdef(nid_tra, "pyv1", "Vent niv 1", "-",
    63      .                iim,jj_nb,nhori, 1,1,1, -99, 32,
    64      .                "inst(X)",  zout,zout)
    65          CALL histdef(nid_tra, "psrf1", "nature sol", "-",
    66      .                iim,jj_nb,nhori, 1,1,1, -99, 32,
    67      .                "inst(X)",  zout,zout)
    68          CALL histdef(nid_tra, "psrf2", "nature sol", "-",
    69      .                iim,jj_nb,nhori, 1,1,1, -99, 32,
    70      .                "inst(X)",  zout,zout)
    71          CALL histdef(nid_tra, "psrf3", "nature sol", "-",
    72      .                iim,jj_nb,nhori, 1,1,1, -99, 32,
    73      .                "inst(X)",  zout,zout)
    74          CALL histdef(nid_tra, "psrf4", "nature sol", "-",
    75      .                iim,jj_nb,nhori, 1,1,1, -99, 32,
    76      .                "inst(X)",  zout,zout)
    77          CALL histdef(nid_tra, "ftsol1", "temper sol", "-",
    78      .                iim,jj_nb,nhori, 1,1,1, -99, 32,
    79      .                "inst(X)",  zout,zout)
    80          CALL histdef(nid_tra, "ftsol2", "temper sol", "-",
    81      .                iim,jj_nb,nhori, 1,1,1, -99, 32,
    82      .                "inst(X)",  zout,zout)
    83          CALL histdef(nid_tra, "ftsol3", "temper sol", "-",
    84      .                iim,jj_nb,nhori, 1,1,1, -99, 32,
    85      .                "inst",  zout,zout)
    86          CALL histdef(nid_tra, "ftsol4", "temper sol", "-",
    87      .                iim,jj_nb,nhori, 1,1,1, -99, 32,
    88      .                "inst(X)",  zout,zout)
    89          CALL histdef(nid_tra, "pplay", "flux u mont","-",
    90      .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    91      .                "inst(X)", zout,zout)
    92          CALL histdef(nid_tra, "t", "flux u mont","-",
    93      .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    94      .                "inst(X)", zout,zout)
    95          CALL histdef(nid_tra, "mfu", "flux u mont","-",
    96      .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    97      .                "ave(X)", zsto,zout)
    98          CALL histdef(nid_tra, "mfd", "flux u decen","-",
    99      .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    100      .                "ave(X)", zsto,zout)
    101          CALL histdef(nid_tra, "en_u", "flux u mont","-",
    102      .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    103      .                "ave(X)", zsto,zout)
    104          CALL histdef(nid_tra, "en_d", "flux u mont","-",
    105      .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    106      .                "ave(X)", zsto,zout)
    107          CALL histdef(nid_tra, "de_d", "flux u mont","-",
    108      .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    109      .                "ave(X)", zsto,zout)
    110          CALL histdef(nid_tra, "de_u", "flux u decen","-",
    111      .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    112      .                "ave(X)", zsto,zout)
    113          CALL histdef(nid_tra, "coefh", "turbulent coef","-",
    114      .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    115      .                "ave(X)", zsto,zout)
     49! TD COUCHE-LIMITE
     50        CALL histdef(nid_tra, "d_tr_cl_"//tname(iiq),      &
     51             "tendance couche limite"// ttext(iiq), "?",   &
     52             iim,jj_nb,nhori, klev,1,klev,nvert, 32,       &
     53             "ave(X)", zsto,zout)
     54     ENDDO
     55!---------------   
     56!
     57! VENT (niveau 1)
     58     CALL histdef(nid_tra, "pyu1", "Vent niv 1", "-",      &
     59          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
     60          "inst(X)",  zout,zout)     
     61     CALL histdef(nid_tra, "pyv1", "Vent niv 1", "-",      &
     62          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
     63          "inst(X)",  zout,zout)
    11664
    117 c
    118          CALL histend(nid_tra)
    119          ndex2d = 0
    120          ndex3d = 0
    121          ndex = 0
    122 c$OMP END MASTER
    123       END IF ! ecrit_tra>0. .AND. config_inca == 'none'
     65! TEMPERATURE DU SOL
     66     CALL histdef(nid_tra, "ftsol1", "temper sol", "-",    &
     67          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
     68          "inst(X)",  zout,zout)
     69     CALL histdef(nid_tra, "ftsol2", "temper sol", "-",    &
     70          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
     71          "inst(X)",  zout,zout)
     72     CALL histdef(nid_tra, "ftsol3", "temper sol", "-",    &
     73          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
     74          "inst",  zout,zout)
     75     CALL histdef(nid_tra, "ftsol4", "temper sol", "-",    &
     76          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
     77          "inst(X)",  zout,zout)
     78
     79! NATURE DU SOL
     80     CALL histdef(nid_tra, "psrf1", "nature sol", "-",     &
     81          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
     82          "inst(X)",  zout,zout)
     83     CALL histdef(nid_tra, "psrf2", "nature sol", "-",     &
     84          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
     85          "inst(X)",  zout,zout)
     86     CALL histdef(nid_tra, "psrf3", "nature sol", "-",     &
     87          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
     88          "inst(X)",  zout,zout)
     89     CALL histdef(nid_tra, "psrf4", "nature sol", "-",     &
     90          iim,jj_nb,nhori, 1,1,1, -99, 32,                 &
     91          "inst(X)",  zout,zout)
     92! DIVERS
     93     CALL histdef(nid_tra, "pplay", "flux u mont","-",     &
     94          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
     95          "inst(X)", zout,zout)
     96     CALL histdef(nid_tra, "t", "flux u mont","-",         &
     97          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
     98          "inst(X)", zout,zout)
     99     CALL histdef(nid_tra, "mfu", "flux u mont","-",       &
     100          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
     101          "ave(X)", zsto,zout)
     102     CALL histdef(nid_tra, "mfd", "flux u decen","-",      &
     103          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
     104          "ave(X)", zsto,zout)
     105     CALL histdef(nid_tra, "en_u", "flux u mont","-",      &
     106          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
     107          "ave(X)", zsto,zout)
     108     CALL histdef(nid_tra, "en_d", "flux u mont","-",      &
     109          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
     110          "ave(X)", zsto,zout)
     111     CALL histdef(nid_tra, "de_d", "flux u mont","-",      &
     112          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
     113          "ave(X)", zsto,zout)
     114     CALL histdef(nid_tra, "de_u", "flux u decen","-",     &
     115          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
     116          "ave(X)", zsto,zout)
     117     CALL histdef(nid_tra, "coefh", "turbulent coef","-",  &
     118          iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
     119          "ave(X)", zsto,zout)   
     120     
     121     CALL histend(nid_tra)
     122!$OMP END MASTER
     123  END IF ! ecrit_tra>0. .AND. config_inca == 'none'
     124 

  • LMDZ4/trunk/libf/phylmd/initphysto.F

    r776 r1279  
    5757C   Arguments
    5858      character*(*) infile
    59       integer*4 nhoriid, i
     59      integer nhoriid, i
    6060      real tstep, t_ops, t_wrt
    6161      integer fileid, filevid

  • LMDZ4/trunk/libf/phylmd/mod_phys_lmdz_omp_transfert.F90

    r1001 r1279  
    1010 
    1111  CHARACTER(LEN=size_min),SAVE            :: buffer_c
    12   INTEGER,SAVE                            :: size_c
     12!  INTEGER,SAVE                            :: size_c=0
    1313  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_i
    14   INTEGER,SAVE                            :: size_i
     14  INTEGER,SAVE                            :: size_i=0
    1515  REAL,SAVE,ALLOCATABLE,DIMENSION(:)      :: buffer_r
    16   INTEGER,SAVE                            :: size_r
     16  INTEGER,SAVE                            :: size_r=0
    1717  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_l
    18   INTEGER,SAVE                            :: size_l
     18  INTEGER,SAVE                            :: size_l=0
    1919
    2020
    … …  
    5656  INTEGER :: buff_size
    5757
    58     IF (buff_size>size_i) THEN
    5958!$OMP BARRIER
    6059!$OMP MASTER
     60    IF (buff_size>size_i) THEN
    6161      IF (ALLOCATED(buffer_i)) DEALLOCATE(buffer_i)
    6262      size_i=MAX(size_min,INT(grow_factor*buff_size))
    6363      ALLOCATE(buffer_i(size_i))
     64    ENDIF
    6465!$OMP END MASTER
    6566!$OMP BARRIER
    66     ENDIF
    6767 
    6868  END SUBROUTINE check_buffer_i
    … …  
    7272  INTEGER :: buff_size
    7373
    74     IF (buff_size>size_r) THEN
    7574!$OMP BARRIER
    7675!$OMP MASTER
     76    IF (buff_size>size_r) THEN
    7777      IF (ALLOCATED(buffer_r)) DEALLOCATE(buffer_r)
    7878      size_r=MAX(size_min,INT(grow_factor*buff_size))
    7979      ALLOCATE(buffer_r(size_r))
     80    ENDIF
    8081!$OMP END MASTER
    8182!$OMP BARRIER
    82     ENDIF
    8383 
    8484  END SUBROUTINE check_buffer_r
    … …  
    8888  INTEGER :: buff_size
    8989
    90     IF (buff_size>size_l) THEN
    9190!$OMP BARRIER
    9291!$OMP MASTER
     92    IF (buff_size>size_l) THEN
    9393      IF (ALLOCATED(buffer_l)) DEALLOCATE(buffer_l)
    9494      size_l=MAX(size_min,INT(grow_factor*buff_size))
    9595      ALLOCATE(buffer_l(size_l))
     96    ENDIF
    9697!$OMP END MASTER
    9798!$OMP BARRIER
    98     ENDIF
    9999 
    100100  END SUBROUTINE check_buffer_l
    … …  
    521521    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
    522522    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
    523    
     523
     524    CALL Check_buffer_r(size(VarOut))       
    524525    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_r)
    525526   

  • LMDZ4/trunk/libf/phylmd/moy_undefSTD.F

    r1233 r1279  
    1414c
    1515c Moyenne - a des frequences differentes - des valeurs bien definies
    16 c         (.NE.missing_val) des variables interpolees a un niveau de
     16c         (.NE.1.E+20) des variables interpolees a un niveau de
    1717c         pression.
    1818c 1) les variables de type "day" (nout=1) ou "mth" (nout=2) sont sommees
    … …  
    2929cym      parameter (jjmp1=jjm+1-1/jjm)
    3030cym#include "dimphy.h"
     31c
    3132c
    3233c variables Input
    … …  
    5253       DO k=1, nlevSTD
    5354        DO i=1, klon
    54          IF(tnondef(i,k,1).NE.(ecrit_day/dtime)) THEN
     55         IF (NINT(tnondef(i,k,1)).NE.NINT(ecrit_day/dtime)) THEN
    5556          tsumSTD(i,k,1)=tsumSTD(i,k,1)/
    5657     $    (ecrit_day/dtime-tnondef(i,k,1))

  • LMDZ4/trunk/libf/phylmd/newmicro.F

    r1146 r1279  
    1 !
    2 ! $Header$
    3 !
     1! $Id$
     2!     
    43      SUBROUTINE newmicro (paprs, pplay,ok_newmicro,
    54     .                  t, pqlwp, pclc, pcltau, pclemi,
    … …  
    76     s                  xflwp, xfiwp, xflwc, xfiwc,
    87     e                  ok_aie,
    9      e                  sulfate, sulfate_pi,
     8     e                  mass_solu_aero, mass_solu_aero_pi,
    109     e                  bl95_b0, bl95_b1,
    11      s                  cldtaupi, re, fl)
     10     s                  cldtaupi, re, fl, reliq, reice)
     11
    1212      USE dimphy
    1313      IMPLICIT none
    … …  
    2222c
    2323c ok_aie--input-L-apply aerosol indirect effect or not
    24 c sulfate-input-R-sulfate aerosol mass concentration [um/m^3]
    25 c sulfate_pi-input-R-dito, pre-industrial value
     24c mass_solu_aero-----input-R-total mass concentration for all soluble aerosols[ug/m^3]
     25c mass_solu_aero_pi--input-R-dito, pre-industrial value
    2626c bl95_b0-input-R-a parameter, may be varied for tests (s-sea, l-land)
    2727c bl95_b1-input-R-a parameter, may be varied for tests (    -"-      )
    … …  
    9494      LOGICAL ok_a1lwpdep       ! a1 LWP dependent?
    9595     
    96       REAL sulfate(klon, klev)  ! sulfate aerosol mass concentration [ug m-3]
     96      REAL mass_solu_aero(klon, klev)    ! total mass concentration for all soluble aerosols [ug m-3]
     97      REAL mass_solu_aero_pi(klon, klev) ! - " - (pre-industrial value)
    9798      REAL cdnc(klon, klev)     ! cloud droplet number concentration [m-3]
    9899      REAL re(klon, klev)       ! cloud droplet effective radius [um]
    99       REAL sulfate_pi(klon, klev)  ! sulfate aerosol mass concentration [ug m-3] (pre-industrial value)
    100100      REAL cdnc_pi(klon, klev)     ! cloud droplet number concentration [m-3] (pi value)
    101101      REAL re_pi(klon, klev)       ! cloud droplet effective radius [um] (pi value)
    … …  
    119119      REAL diff_paprs(klon, klev), zfice1, zfice2(klon, klev)
    120120      REAL rad_chaud_tab(klon, klev), zflwp_var, zfiwp_var
     121
     122! Abderrahmane oct 2009
     123      Real reliq(klon, klev), reice(klon, klev)
    121124
    122125c
    … …  
    157160                                !             
    158161                  cdnc(i,k) = 10.**(bl95_b0+bl95_b1*
    159      &                 log(MAX(sulfate(i,k),1.e-4))/log(10.))*1.e6 !-m-3
     162     &               log(MAX(mass_solu_aero(i,k),1.e-4))/log(10.))*1.e6 !-m-3
    160163                                ! Cloud droplet number concentration (CDNC) is restricted
    161164                                ! to be within [20, 1000 cm^3]
    … …  
    165168                                !
    166169                  cdnc_pi(i,k) = 10.**(bl95_b0+bl95_b1*
    167      &                 log(MAX(sulfate_pi(i,k),1.e-4))/log(10.))*1.e6 !-m-3
     170     &               log(MAX(mass_solu_aero_pi(i,k),1.e-4))/log(10.))*1.e6 !-m-3
    168171                  cdnc_pi(i,k)=MIN(1000.e6,MAX(20.e6,cdnc_pi(i,k)))
    169172               ENDDO
    … …  
    221224                  re(i,k) = rad_chaud_tab(i,k)*fl(i,k)
    222225                 
     226                  rel = 0.
     227                  rei = 0.
    223228                  pclc(i,k) = 0.0
    224229                  pcltau(i,k) = 0.0
    … …  
    252257                     cldtaupi(i,k) = 3.0/2.0 * zflwp_var / radius
    253258     &                    + zfiwp_var * (3.448e-03  + 2.431/rei)
     259
    254260                  ENDIF         ! ok_aie
    255261                                ! For output diagnostics
    … …  
    280286c     for ice clouds, Ebert & Curry (1992)]
    281287                 
    282                   if (zflwp_var.eq.0.) rel = 1.
    283                   if (zfiwp_var.eq.0. .or. rei.le.0.) rei = 1.
    284                   pcltau(i,k) = 3.0/2.0 * ( zflwp_var/rel )
     288                 if (zflwp_var.eq.0.) rel = 1.
     289                 if (zfiwp_var.eq.0. .or. rei.le.0.) rei = 1.
     290                 pcltau(i,k) = 3.0/2.0 * ( zflwp_var/rel )
    285291     &                 + zfiwp_var * (3.448e-03  + 2.431/rei)
    286292c     -- cloud infrared emissivity:
    … …  
    296302
    297303               ENDIF
    298                
     304              reliq(i,k)=rel
     305              reice(i,k)=rei
     306!              if (i.eq.1) then
     307!              print*,'Dans newmicro rel, rei :',rel, rei
     308!              print*,'Dans newmicro reliq, reice :',
     309!     $             reliq(i,k),reice(i,k)
     310!              endif
     311
    299312            ENDDO
    300313         ENDDO
    … …  
    400413            DO i = 1, klon
    401414               zclear(i)=zclear(i)*(1.-MAX(pclc(i,k),zcloud(i)))
    402      &              /(1.-MIN(zcloud(i),1.-ZEPSEC))
     415     &              /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC))
    403416               pct(i)=1.-zclear(i)
    404417               IF (pplay(i,k).LE.cetahb*paprs(i,1)) THEN
    405418                  pch(i) = pch(i)*(1.-MAX(pclc(i,k),zcloud(i)))
    406      &                 /(1.-MIN(zcloud(i),1.-ZEPSEC))
     419     &                 /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC))
    407420               ELSE IF (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
    408421     &                 pplay(i,k).LE.cetamb*paprs(i,1)) THEN
    409422                  pcm(i) = pcm(i)*(1.-MAX(pclc(i,k),zcloud(i)))
    410      &                 /(1.-MIN(zcloud(i),1.-ZEPSEC))
     423     &                 /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC))
    411424               ELSE IF (pplay(i,k).GT.cetamb*paprs(i,1)) THEN
    412425                  pcl(i) = pcl(i)*(1.-MAX(pclc(i,k),zcloud(i)))
    413      &                 /(1.-MIN(zcloud(i),1.-ZEPSEC))
     426     &                 /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC))
    414427               endif
    415428               zcloud(i)=pclc(i,k)

  • LMDZ4/trunk/libf/phylmd/nuage.F

    r766 r1279  
    1 !
    2 ! $Header$
     1! $Id$
    32!
    43      SUBROUTINE nuage (paprs, pplay,
    … …  
    65     .                  pch, pcl, pcm, pct, pctlwp,
    76     e                  ok_aie,
    8      e                  sulfate, sulfate_pi,
     7     e                  mass_solu_aero, mass_solu_aero_pi,
    98     e                  bl95_b0, bl95_b1,
    109     s                  cldtaupi, re, fl)
    … …  
    2019c pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1)
    2120c ok_aie--input-L-apply aerosol indirect effect or not
    22 c sulfate-input-R-sulfate aerosol mass concentration [um/m^3]
    23 c sulfate_pi-input-R-dito, pre-industrial value
     21c mass_solu_aero-----input-R-total mass concentration for all soluble aerosols[ug/m^3]
     22c mass_solu_aero_pi--input-R-dito, pre-industrial value
    2423c bl95_b0-input-R-a parameter, may be varied for tests (s-sea, l-land)
    2524c bl95_b1-input-R-a parameter, may be varied for tests (    -"-      )
    … …  
    7473      LOGICAL ok_aie            ! Apply AIE or not?
    7574     
    76       REAL sulfate(klon, klev)  ! sulfate aerosol mass concentration [ug m-3]
     75      REAL mass_solu_aero(klon, klev)    ! total mass concentration for all soluble aerosols[ug m-3]
     76      REAL mass_solu_aero_pi(klon, klev) ! - " - pre-industrial value
    7777      REAL cdnc(klon, klev)     ! cloud droplet number concentration [m-3]
    7878      REAL re(klon, klev)       ! cloud droplet effective radius [um]
    79       REAL sulfate_pi(klon, klev)  ! sulfate aerosol mass concentration [ug m-3] (pre-industrial value)
    8079      REAL cdnc_pi(klon, klev)     ! cloud droplet number concentration [m-3] (pi value)
    8180      REAL re_pi(klon, klev)       ! cloud droplet effective radius [um] (pi value)
    … …  
    108107            !             
    109108            cdnc(i,k) = 10.**(bl95_b0+bl95_b1*
    110      .           log(MAX(sulfate(i,k),1.e-4))/log(10.))*1.e6 !-m-3
     109     .           log(MAX(mass_solu_aero(i,k),1.e-4))/log(10.))*1.e6 !-m-3
    111110            ! Cloud droplet number concentration (CDNC) is restricted
    112111            ! to be within [20, 1000 cm^3]
    … …  
    114113            cdnc(i,k)=MIN(1000.e6,MAX(20.e6,cdnc(i,k)))
    115114            cdnc_pi(i,k) = 10.**(bl95_b0+bl95_b1*
    116      .           log(MAX(sulfate_pi(i,k),1.e-4))/log(10.))*1.e6 !-m-3
     115     .           log(MAX(mass_solu_aero_pi(i,k),1.e-4))/log(10.))*1.e6 !-m-3
    117116            cdnc_pi(i,k)=MIN(1000.e6,MAX(20.e6,cdnc_pi(i,k)))
    118117            !           

  • LMDZ4/trunk/libf/phylmd/oasis.F90

    r1146 r1279  
    2222 
    2323  IMPLICIT NONE
    24    
    25 ! Maximum number of fields exchanged between ocean and atmosphere
    26   INTEGER, PARAMETER  :: jpmaxfld=40
    27 ! Number of fields exchanged from atmosphere to ocean via flx.F
    28   INTEGER, PARAMETER  :: jpflda2o1=13
    29 ! Number of fields exchanged from atmosphere to ocean via tau.F
    30   INTEGER, PARAMETER  :: jpflda2o2=6
    31 ! Number of fields exchanged from ocean to atmosphere
    32   INTEGER  :: jpfldo2a
    33 
    34   CHARACTER (len=8), DIMENSION(jpmaxfld), PUBLIC, SAVE   :: cl_read
    35   !$OMP THREADPRIVATE(cl_read)
    36   CHARACTER (len=8), DIMENSION(jpmaxfld), PUBLIC, SAVE   :: cl_writ
    37   !$OMP THREADPRIVATE(cl_writ)
    38 
    39   INTEGER, DIMENSION(jpmaxfld), SAVE, PRIVATE            :: in_var_id
    40   !$OMP THREADPRIVATE(in_var_id)
    41   INTEGER, DIMENSION(jpflda2o1+jpflda2o2), SAVE, PRIVATE :: out_var_id
    42   !$OMP THREADPRIVATE(out_var_id)
    43 
    44   LOGICAL :: cpl_current
     24 
     25  ! Id for fields sent to ocean
     26  INTEGER, PARAMETER :: ids_tauxxu = 1
     27  INTEGER, PARAMETER :: ids_tauyyu = 2
     28  INTEGER, PARAMETER :: ids_tauzzu = 3
     29  INTEGER, PARAMETER :: ids_tauxxv = 4
     30  INTEGER, PARAMETER :: ids_tauyyv = 5
     31  INTEGER, PARAMETER :: ids_tauzzv = 6
     32  INTEGER, PARAMETER :: ids_windsp = 7
     33  INTEGER, PARAMETER :: ids_shfice = 8
     34  INTEGER, PARAMETER :: ids_shfoce = 9
     35  INTEGER, PARAMETER :: ids_shftot = 10
     36  INTEGER, PARAMETER :: ids_nsfice = 11
     37  INTEGER, PARAMETER :: ids_nsfoce = 12
     38  INTEGER, PARAMETER :: ids_nsftot = 13
     39  INTEGER, PARAMETER :: ids_dflxdt = 14
     40  INTEGER, PARAMETER :: ids_totrai = 15
     41  INTEGER, PARAMETER :: ids_totsno = 16
     42  INTEGER, PARAMETER :: ids_toteva = 17
     43  INTEGER, PARAMETER :: ids_icevap = 18
     44  INTEGER, PARAMETER :: ids_ocevap = 19
     45  INTEGER, PARAMETER :: ids_calvin = 20
     46  INTEGER, PARAMETER :: ids_liqrun = 21
     47  INTEGER, PARAMETER :: ids_runcoa = 22
     48  INTEGER, PARAMETER :: ids_rivflu = 23
     49  INTEGER, PARAMETER :: ids_atmco2 = 24
     50  INTEGER, PARAMETER :: ids_taumod = 25
     51  INTEGER, PARAMETER :: maxsend    = 25  ! Maximum number of fields to send
     52 
     53  ! Id for fields received from ocean
     54  INTEGER, PARAMETER :: idr_sisutw = 1
     55  INTEGER, PARAMETER :: idr_icecov = 2
     56  INTEGER, PARAMETER :: idr_icealw = 3
     57  INTEGER, PARAMETER :: idr_icetem = 4
     58  INTEGER, PARAMETER :: idr_curenx = 5
     59  INTEGER, PARAMETER :: idr_cureny = 6
     60  INTEGER, PARAMETER :: idr_curenz = 7
     61  INTEGER, PARAMETER :: idr_oceco2 = 8
     62  INTEGER, PARAMETER :: maxrecv    = 8  ! Maximum number of fields to receive
     63 
     64
     65  TYPE, PUBLIC ::   FLD_CPL            ! Type for coupling field information
     66     CHARACTER(len = 8) ::   name      ! Name of the coupling field   
     67     LOGICAL            ::   action    ! To be exchanged or not
     68     INTEGER            ::   nid       ! Id of the field
     69  END TYPE FLD_CPL
     70
     71  TYPE(FLD_CPL), DIMENSION(maxsend), SAVE, PUBLIC :: infosend   ! Information for sending coupling fields
     72  TYPE(FLD_CPL), DIMENSION(maxrecv), SAVE, PUBLIC :: inforecv   ! Information for receiving coupling fields
     73 
     74  LOGICAL,SAVE :: cpl_current
     75!$OMP THREADPRIVATE(cpl_current)
    4576
    4677#ifdef CPP_COUPLE
    … …  
    5889    USE IOIPSL
    5990    USE surface_data, ONLY : version_ocean
     91    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
     92
    6093    INCLUDE "dimensions.h"
     94    INCLUDE "iniprint.h"
    6195
    6296! Local variables
    … …  
    69103    INTEGER, DIMENSION(4)              :: il_var_actual_shape
    70104    INTEGER                            :: il_var_type
    71     INTEGER                            :: nuout = 6
    72105    INTEGER                            :: jf
    73106    CHARACTER (len = 6)                :: clmodnam
    … …  
    79112!        ---------------
    80113!************************************************************************************
    81     WRITE(nuout,*) ' '
    82     WRITE(nuout,*) ' '
    83     WRITE(nuout,*) ' ROUTINE INICMA'
    84     WRITE(nuout,*) ' **************'
    85     WRITE(nuout,*) ' '
    86     WRITE(nuout,*) ' '
     114    WRITE(lunout,*) ' '
     115    WRITE(lunout,*) ' '
     116    WRITE(lunout,*) ' ROUTINE INICMA'
     117    WRITE(lunout,*) ' **************'
     118    WRITE(lunout,*) ' '
     119    WRITE(lunout,*) ' '
    87120
    88121!
    … …  
    90123!
    91124    clmodnam = 'lmdz.x'       ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
     125
    92126
    93127!************************************************************************************
    … …  
    100134!$OMP BARRIER
    101135    cpl_current = cpl_current_omp
    102     WRITE(nuout,*) 'Couple ocean currents, cpl_current = ',cpl_current
    103 
    104     IF (cpl_current) THEN
    105        jpfldo2a=7
    106     ELSE
    107        jpfldo2a=4
    108     END IF
     136    WRITE(lunout,*) 'Couple ocean currents, cpl_current = ',cpl_current
     137
     138!************************************************************************************
     139! Define coupling variables
     140!************************************************************************************
     141
     142! Atmospheric variables to send
     143
     144!$OMP MASTER
     145    infosend(:)%action = .FALSE.
     146
     147    infosend(ids_tauxxu)%action = .TRUE. ; infosend(ids_tauxxu)%name = 'COTAUXXU'
     148    infosend(ids_tauyyu)%action = .TRUE. ; infosend(ids_tauyyu)%name = 'COTAUYYU'
     149    infosend(ids_tauzzu)%action = .TRUE. ; infosend(ids_tauzzu)%name = 'COTAUZZU'
     150    infosend(ids_tauxxv)%action = .TRUE. ; infosend(ids_tauxxv)%name = 'COTAUXXV'
     151    infosend(ids_tauyyv)%action = .TRUE. ; infosend(ids_tauyyv)%name = 'COTAUYYV'
     152    infosend(ids_tauzzv)%action = .TRUE. ; infosend(ids_tauzzv)%name = 'COTAUZZV'
     153    infosend(ids_windsp)%action = .TRUE. ; infosend(ids_windsp)%name = 'COWINDSP'
     154    infosend(ids_shfice)%action = .TRUE. ; infosend(ids_shfice)%name = 'COSHFICE'
     155    infosend(ids_nsfice)%action = .TRUE. ; infosend(ids_nsfice)%name = 'CONSFICE'
     156    infosend(ids_dflxdt)%action = .TRUE. ; infosend(ids_dflxdt)%name = 'CODFLXDT'
     157    infosend(ids_calvin)%action = .TRUE. ; infosend(ids_calvin)%name = 'COCALVIN'
     158   
     159    IF (version_ocean=='nemo') THEN
     160        infosend(ids_shftot)%action = .TRUE. ; infosend(ids_shftot)%name = 'COQSRMIX'
     161        infosend(ids_nsftot)%action = .TRUE. ; infosend(ids_nsftot)%name = 'COQNSMIX'
     162        infosend(ids_totrai)%action = .TRUE. ; infosend(ids_totrai)%name = 'COTOTRAI'
     163        infosend(ids_totsno)%action = .TRUE. ; infosend(ids_totsno)%name = 'COTOTSNO'
     164        infosend(ids_toteva)%action = .TRUE. ; infosend(ids_toteva)%name = 'COTOTEVA'
     165        infosend(ids_icevap)%action = .TRUE. ; infosend(ids_icevap)%name = 'COICEVAP'
     166        infosend(ids_liqrun)%action = .TRUE. ; infosend(ids_liqrun)%name = 'COLIQRUN'
     167        infosend(ids_taumod)%action = .TRUE. ; infosend(ids_taumod)%name = 'COTAUMOD'
     168        IF (carbon_cycle_cpl) THEN
     169            infosend(ids_atmco2)%action = .TRUE. ; infosend(ids_atmco2)%name = 'COATMCO2'
     170        ENDIF
     171       
     172    ELSE IF (version_ocean=='opa8') THEN
     173        infosend(ids_shfoce)%action = .TRUE. ; infosend(ids_shfoce)%name = 'COSHFOCE'
     174        infosend(ids_nsfoce)%action = .TRUE. ; infosend(ids_nsfoce)%name = 'CONSFOCE'
     175        infosend(ids_icevap)%action = .TRUE. ; infosend(ids_icevap)%name = 'COTFSICE'
     176        infosend(ids_ocevap)%action = .TRUE. ; infosend(ids_ocevap)%name = 'COTFSOCE'
     177        infosend(ids_totrai)%action = .TRUE. ; infosend(ids_totrai)%name = 'COTOLPSU'
     178        infosend(ids_totsno)%action = .TRUE. ; infosend(ids_totsno)%name = 'COTOSPSU'
     179        infosend(ids_runcoa)%action = .TRUE. ; infosend(ids_runcoa)%name = 'CORUNCOA'
     180        infosend(ids_rivflu)%action = .TRUE. ; infosend(ids_rivflu)%name = 'CORIVFLU'
     181   ENDIF
     182       
     183! Oceanic variables to receive
     184
     185   inforecv(:)%action = .FALSE.
     186
     187   inforecv(idr_sisutw)%action = .TRUE. ; inforecv(idr_sisutw)%name = 'SISUTESW'
     188   inforecv(idr_icecov)%action = .TRUE. ; inforecv(idr_icecov)%name = 'SIICECOV'
     189   inforecv(idr_icealw)%action = .TRUE. ; inforecv(idr_icealw)%name = 'SIICEALW'
     190   inforecv(idr_icetem)%action = .TRUE. ; inforecv(idr_icetem)%name = 'SIICTEMW'
     191   
     192   IF (cpl_current ) THEN
     193       inforecv(idr_curenx)%action = .TRUE. ; inforecv(idr_curenx)%name = 'CURRENTX'
     194       inforecv(idr_cureny)%action = .TRUE. ; inforecv(idr_cureny)%name = 'CURRENTY'
     195       inforecv(idr_curenz)%action = .TRUE. ; inforecv(idr_curenz)%name = 'CURRENTZ'
     196   ENDIF
     197
     198   IF (carbon_cycle_cpl ) THEN
     199       inforecv(idr_oceco2)%action = .TRUE. ; inforecv(idr_oceco2)%name = 'SICO2FLX'
     200   ENDIF
     201
    109202!************************************************************************************
    110203! Here we go: psmile initialisation
    … …  
    117210          CALL abort_gcm(modname,abort_message,1)
    118211       ELSE
    119           WRITE(nuout,*) 'inicma : init psmile ok '
     212          WRITE(lunout,*) 'inicma : init psmile ok '
    120213       ENDIF
    121214    ENDIF
    … …  
    130223
    131224    IF (mpi_rank==mpi_size-1) ig_paral(3)=ig_paral(3)+iim-1
    132     WRITE(nuout,*) mpi_rank,'ig_paral--->',ig_paral(2),ig_paral(3)
     225    WRITE(lunout,*) mpi_rank,'ig_paral--->',ig_paral(2),ig_paral(3)
    133226   
    134227    ierror=PRISM_Ok
    … …  
    139232       CALL abort_gcm(modname,abort_message,1)
    140233    ELSE
    141        WRITE(nuout,*) 'inicma : decomposition domaine psmile ok '
    142     ENDIF
    143 
    144 !************************************************************************************
    145 ! Field Declarations
    146 !************************************************************************************
    147 !     Define symbolic name for fields exchanged from atmos to coupler,
    148 !         must be the same as (1) of the field definition in namcouple:
    149 !
    150 !   Initialization
    151     cl_writ(:)='NOFLDATM'
    152 
    153     cl_writ(1)='COTAUXXU'
    154     cl_writ(2)='COTAUYYU'
    155     cl_writ(3)='COTAUZZU'
    156     cl_writ(4)='COTAUXXV'
    157     cl_writ(5)='COTAUYYV'
    158     cl_writ(6)='COTAUZZV'
    159     cl_writ(7)='COWINDSP'
    160     cl_writ(8)='COSHFICE'
    161     cl_writ(10)='CONSFICE'
    162     cl_writ(12)='CODFLXDT'
    163 
    164     IF (version_ocean=='nemo') THEN
    165       cl_writ(9)='COQSRMIX'
    166       cl_writ(11)='COQNSMIX'
    167       cl_writ(13)='COTOTRAI'
    168       cl_writ(14)='COTOTSNO'
    169       cl_writ(15)='COTOTEVA'
    170       cl_writ(16)='COICEVAP'
    171       cl_writ(17)='COCALVIN'
    172       cl_writ(18)='COLIQRUN'
    173     ELSE IF (version_ocean=='opa8') THEN
    174        cl_writ(9)='COSHFOCE'
    175        cl_writ(11)='CONSFOCE'
    176        cl_writ(13)='COTFSICE'
    177        cl_writ(14)='COTFSOCE'
    178        cl_writ(15)='COTOLPSU'
    179        cl_writ(16)='COTOSPSU'
    180        cl_writ(17)='CORUNCOA'
    181        cl_writ(18)='CORIVFLU'
    182        cl_writ(19)='COCALVIN'
    183     ENDIF
    184 
    185 !
    186 !     Define symbolic name for fields exchanged from coupler to atmosphere,
    187 !         must be the same as (2) of the field definition in namcouple:
    188 !
    189 !   Initialization
    190     cl_read(:)='NOFLDATM'
    191 
    192     cl_read(1)='SISUTESW'
    193     cl_read(2)='SIICECOV'
    194     cl_read(3)='SIICEALW'
    195     cl_read(4)='SIICTEMW'
    196 
    197     IF (cpl_current) THEN
    198        cl_read(5)='CURRENTX'
    199        cl_read(6)='CURRENTY'
    200        cl_read(7)='CURRENTZ'
    201     END IF
     234       WRITE(lunout,*) 'inicma : decomposition domaine psmile ok '
     235    ENDIF
    202236
    203237    il_var_nodims(1) = 2
    … …  
    212246
    213247!************************************************************************************
    214 ! Oceanic Fields
    215 !************************************************************************************
    216     DO jf=1, jpfldo2a
    217        CALL prism_def_var_proto(in_var_id(jf), cl_read(jf), il_part_id, &
    218             il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, &
    219             ierror)
    220        IF (ierror .NE. PRISM_Ok) THEN
    221           abort_message=' Probleme init dans prism_def_var_proto '
    222           CALL abort_gcm(modname,abort_message,1)
     248! Oceanic Fields to receive
     249! Loop over all possible variables
     250!************************************************************************************
     251    DO jf=1, maxrecv
     252       IF (inforecv(jf)%action) THEN
     253          CALL prism_def_var_proto(inforecv(jf)%nid, inforecv(jf)%name, il_part_id, &
     254               il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, &
     255               ierror)
     256          IF (ierror .NE. PRISM_Ok) THEN
     257             WRITE(lunout,*) 'inicma : Problem with prism_def_var_proto for field : ',&
     258                  inforecv(jf)%name
     259             abort_message=' Problem in call to prism_def_var_proto for fields to receive'
     260             CALL abort_gcm(modname,abort_message,1)
     261          ENDIF
    223262       ENDIF
    224263    END DO
    225 
    226 !************************************************************************************
    227 ! Atmospheric Fields
    228 !************************************************************************************
    229     DO jf=1, jpflda2o1+jpflda2o2
    230        CALL prism_def_var_proto(out_var_id(jf), cl_writ(jf), il_part_id, &
    231             il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, &
    232             ierror)
    233        IF (ierror .NE. PRISM_Ok) THEN
    234           abort_message=' Probleme init dans prism_def_var_proto '
    235           CALL abort_gcm(modname,abort_message,1)
     264   
     265!************************************************************************************
     266! Atmospheric Fields to send
     267! Loop over all possible variables
     268!************************************************************************************
     269    DO jf=1,maxsend
     270       IF (infosend(jf)%action) THEN
     271          CALL prism_def_var_proto(infosend(jf)%nid, infosend(jf)%name, il_part_id, &
     272               il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, &
     273               ierror)
     274          IF (ierror .NE. PRISM_Ok) THEN
     275             WRITE(lunout,*) 'inicma : Problem with prism_def_var_proto for field : ',&
     276                  infosend(jf)%name
     277             abort_message=' Problem in call to prism_def_var_proto for fields to send'
     278             CALL abort_gcm(modname,abort_message,1)
     279          ENDIF
    236280       ENDIF
    237281    END DO
    238 
     282   
    239283!************************************************************************************
    240284! End definition
    … …  
    242286    CALL prism_enddef_proto(ierror)
    243287    IF (ierror .NE. PRISM_Ok) THEN
    244        abort_message=' Probleme init dans prism_ endef_proto'
     288       abort_message=' Problem in call to prism_endef_proto'
    245289       CALL abort_gcm(modname,abort_message,1)
    246290    ELSE
    247        WRITE(nuout,*) 'inicma : endef psmile ok '
    248     ENDIF
     291       WRITE(lunout,*) 'inicma : endef psmile ok '
     292    ENDIF
     293
     294!$OMP END MASTER
    249295   
    250296  END SUBROUTINE inicma
    … …  
    261307!
    262308    INCLUDE "dimensions.h"
     309    INCLUDE "iniprint.h"
    263310! Input arguments
    264311!************************************************************************************
    … …  
    267314! Output arguments
    268315!************************************************************************************
    269     REAL, DIMENSION(iim, jj_nb,jpfldo2a), INTENT(OUT) :: tab_get
     316    REAL, DIMENSION(iim, jj_nb,maxrecv), INTENT(OUT) :: tab_get
    270317
    271318! Local variables
    272319!************************************************************************************
    273     INTEGER                       :: nuout  = 6             ! listing output unit
    274320    INTEGER                       :: ierror, i
    275321    INTEGER                       :: istart,iend
    … …  
    279325
    280326!************************************************************************************
    281     WRITE (nuout,*) ' '
    282     WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, ktime=',ktime
    283     WRITE (nuout,*) ' '
     327    WRITE (lunout,*) ' '
     328    WRITE (lunout,*) 'Fromcpl: Reading fields from CPL, ktime=',ktime
     329    WRITE (lunout,*) ' '
    284330   
    285331    istart=ii_begin
    … …  
    290336    ENDIF
    291337   
    292     DO i = 1, jpfldo2a
    293        field(:) = -99999.
    294        CALL prism_get_proto(in_var_id(i), ktime, field(istart:iend), ierror)
    295        tab_get(:,:,i) = RESHAPE(field(:),(/iim,jj_nb/))
     338    DO i = 1, maxrecv
     339      IF (inforecv(i)%action) THEN
     340          field(:) = -99999.
     341          CALL prism_get_proto(inforecv(i)%nid, ktime, field(istart:iend), ierror)
     342          tab_get(:,:,i) = RESHAPE(field(:),(/iim,jj_nb/))
    296343       
    297        IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Recvd .AND. &
    298             ierror.NE.PRISM_FromRest &
    299             .AND. ierror.NE.PRISM_Input .AND. ierror.NE.PRISM_RecvOut &
    300             .AND. ierror.NE.PRISM_FromRestOut) THEN
    301           WRITE (nuout,*)  cl_read(i), ktime   
    302           abort_message=' Probleme dans prism_get_proto '
    303           CALL abort_gcm(modname,abort_message,1)
    304        ENDIF
     344          IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Recvd .AND. &
     345             ierror.NE.PRISM_FromRest &
     346             .AND. ierror.NE.PRISM_Input .AND. ierror.NE.PRISM_RecvOut &
     347             .AND. ierror.NE.PRISM_FromRestOut) THEN
     348              WRITE (lunout,*)  'Error with receiving filed : ', inforecv(i)%name, ktime   
     349              abort_message=' Problem in prism_get_proto '
     350              CALL abort_gcm(modname,abort_message,1)
     351          ENDIF
     352      ENDIF
    305353    END DO
    306354   
    … …  
    321369!
    322370    INCLUDE "dimensions.h"
     371    INCLUDE "iniprint.h"
    323372! Input arguments
    324373!************************************************************************************
    325     INTEGER, INTENT(IN)                                          :: ktime
    326     LOGICAL, INTENT(IN)                                          :: last
    327     REAL, DIMENSION(iim, jj_nb, jpflda2o1+jpflda2o2), INTENT(IN) :: tab_put
     374    INTEGER, INTENT(IN)                              :: ktime
     375    LOGICAL, INTENT(IN)                              :: last
     376    REAL, DIMENSION(iim, jj_nb, maxsend), INTENT(IN) :: tab_put
    328377
    329378! Local variables
    … …  
    332381    INTEGER                          :: istart,iend
    333382    INTEGER                          :: wstart,wend
    334     INTEGER, PARAMETER               :: nuout = 6
    335383    INTEGER                          :: ierror, i
    336384    REAL, DIMENSION(iim*jj_nb)       :: field
    … …  
    341389    checkout=.FALSE.
    342390
    343     WRITE(nuout,*) ' '
    344     WRITE(nuout,*) 'Intocpl: sending fields to CPL, ktime= ', ktime
    345     WRITE(nuout,*) 'last ', last
    346     WRITE(nuout,*)
     391    WRITE(lunout,*) ' '
     392    WRITE(lunout,*) 'Intocpl: sending fields to CPL, ktime= ', ktime
     393    WRITE(lunout,*) 'last = ', last
     394    WRITE(lunout,*)
    347395
    348396
    … …  
    360408       IF (is_south_pole) wend=iend-iim+1
    361409       
    362        field = RESHAPE(tab_put(:,:,8),(/iim*jj_nb/))
    363        CALL writeField_phy("fsolice",field(wstart:wend),1)
    364        field = RESHAPE(tab_put(:,:,9),(/iim*jj_nb/))
    365        CALL writeField_phy("fsolwat",field(wstart:wend),1)
    366        field = RESHAPE(tab_put(:,:,10),(/iim*jj_nb/))
    367        CALL writeField_phy("fnsolice",field(wstart:wend),1)
    368        field = RESHAPE(tab_put(:,:,11),(/iim*jj_nb/))
    369        CALL writeField_phy("fnsolwat",field(wstart:wend),1)
    370        field = RESHAPE(tab_put(:,:,12),(/iim*jj_nb/))
    371        CALL writeField_phy("fnsicedt",field(wstart:wend),1)
    372        field = RESHAPE(tab_put(:,:,13),(/iim*jj_nb/))
    373        CALL writeField_phy("evice",field(wstart:wend),1)
    374        field = RESHAPE(tab_put(:,:,14),(/iim*jj_nb/))
    375        CALL writeField_phy("evwat",field(wstart:wend),1)
    376        field = RESHAPE(tab_put(:,:,15),(/iim*jj_nb/))
    377        CALL writeField_phy("lpre",field(wstart:wend),1)
    378        field = RESHAPE(tab_put(:,:,16),(/iim*jj_nb/))
    379        CALL writeField_phy("spre",field(wstart:wend),1)
    380        field = RESHAPE(tab_put(:,:,17),(/iim*jj_nb/))
    381        CALL writeField_phy("dirunoff",field(wstart:wend),1)
    382        field = RESHAPE(tab_put(:,:,18),(/iim*jj_nb/))
    383        CALL writeField_phy("rivrunoff",field(wstart:wend),1)
    384        field = RESHAPE(tab_put(:,:,19),(/iim*jj_nb/))
    385        CALL writeField_phy("calving",field(wstart:wend),1)
    386        field = RESHAPE(tab_put(:,:,1),(/iim*jj_nb/))
    387        CALL writeField_phy("tauxx_u",field(wstart:wend),1)
    388        field = RESHAPE(tab_put(:,:,2),(/iim*jj_nb/))
    389        CALL writeField_phy("tauyy_u",field(wstart:wend),1)
    390        field = RESHAPE(tab_put(:,:,3),(/iim*jj_nb/))
    391        CALL writeField_phy("tauzz_u",field(wstart:wend),1)
    392        field = RESHAPE(tab_put(:,:,4),(/iim*jj_nb/))
    393        CALL writeField_phy("tauxx_v",field(wstart:wend),1)
    394        field = RESHAPE(tab_put(:,:,5),(/iim*jj_nb/))
    395        CALL writeField_phy("tauyy_v",field(wstart:wend),1)
    396        field = RESHAPE(tab_put(:,:,6),(/iim*jj_nb/))
    397        CALL writeField_phy("tauzz_v",field(wstart:wend),1)
    398        field = RESHAPE(tab_put(:,:,7),(/iim*jj_nb/))
    399        CALL writeField_phy("windsp",field(wstart:wend),1)
    400     ENDIF
    401    
     410       DO i = 1, maxsend
     411          IF (infosend(i)%action) THEN
     412             field = RESHAPE(tab_put(:,:,i),(/iim*jj_nb/))
     413             CALL writefield_phy(infosend(i)%name,field(wstart:wend),1)
     414          END IF
     415       END DO
     416    END IF
     417
    402418!************************************************************************************
    403419! PRISM_PUT
    404420!************************************************************************************
    405421
    406     DO i = 1, jpflda2o1+jpflda2o2
    407        field = RESHAPE(tab_put(:,:,i),(/iim*jj_nb/))
    408        CALL prism_put_proto(out_var_id(i), ktime, field(istart:iend), ierror)
    409        
    410        IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Sent .AND. ierror.NE.PRISM_ToRest &
    411             .AND. ierror.NE.PRISM_LocTrans .AND. ierror.NE.PRISM_Output .AND. &
    412             ierror.NE.PRISM_SentOut .AND. ierror.NE.PRISM_ToRestOut) THEN
    413           WRITE (nuout,*)  cl_writ(i), ktime   
    414           abort_message=' Probleme dans prism_put_proto '
    415           CALL abort_gcm(modname,abort_message,1)
    416        ENDIF
    417        
     422    DO i = 1, maxsend
     423      IF (infosend(i)%action) THEN
     424          field = RESHAPE(tab_put(:,:,i),(/iim*jj_nb/))
     425          CALL prism_put_proto(infosend(i)%nid, ktime, field(istart:iend), ierror)
     426         
     427          IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Sent .AND. ierror.NE.PRISM_ToRest &
     428             .AND. ierror.NE.PRISM_LocTrans .AND. ierror.NE.PRISM_Output .AND. &
     429             ierror.NE.PRISM_SentOut .AND. ierror.NE.PRISM_ToRestOut) THEN
     430              WRITE (lunout,*) 'Error with sending field :', infosend(i)%name, ktime   
     431              abort_message=' Problem in prism_put_proto '
     432              CALL abort_gcm(modname,abort_message,1)
     433          ENDIF
     434      ENDIF
    418435    END DO
    419436   
    … …  
    427444          CALL prism_terminate_proto(ierror)
    428445          IF (ierror .NE. PRISM_Ok) THEN
    429              abort_message=' Probleme dans prism_terminate_proto '
     446             abort_message=' Problem in prism_terminate_proto '
    430447             CALL abort_gcm(modname,abort_message,1)
    431448          ENDIF

  • LMDZ4/trunk/libf/phylmd/orbite.F

    r766 r1279  
    124124c          revu pour  GCM  le 30 septembre 1996
    125125c===============================================================
    126 c longi----INPUT : la longitude vraie de la terre dans son plan
     126c longi : la longitude vraie de la terre dans son plan
    127127c                  solaire a partir de l'equinoxe de printemps (degre)
    128 c gmtime---INPUT : temps universel en fraction de jour
    129 c pdtrad---INPUT : pas de temps du rayonnement (secondes)
     128c gmtime : temps universel en fraction de jour
     129c pdtrad : pas de temps du rayonnement (secondes)
    130130c lat------INPUT : latitude en degres
    131131c long-----INPUT : longitude en degres
    … …  
    137137#include "YOMCST.h"
    138138c================================================================
    139       real longi, gmtime, pdtrad
     139      real, intent(in):: longi, gmtime, pdtrad
    140140      real lat(klon), long(klon), pmu0(klon), frac(klon)
    141141c================================================================

  • LMDZ4/trunk/libf/phylmd/orografi.F

    r776 r1279  
    17921792           
    17931793      DO 110 JK=1,NLEV
    1794       ZPM1R=pplay_glo(klon_glo/2,jk)/paprs_glo(klon_glo/2,1)
     1794      ZPM1R=pplay_glo((klon_glo/2)+1,jk)/paprs_glo((klon_glo/2)+1,1)
    17951795      IF(ZPM1R.GE.ZSIGT)THEN
    17961796         nktopg=JK
    17971797      ENDIF
    1798       ZPM1R=pplay_glo(klon_glo/2,jk)/paprs_glo(klon_glo/2,1)
     1798      ZPM1R=pplay_glo((klon_glo/2)+1,jk)/paprs_glo((klon_glo/2)+1,1)
    17991799      IF(ZPM1R.GE.ZSTRA)THEN
    18001800         NSTRA=JK

  • LMDZ4/trunk/libf/phylmd/pbl_surface_mod.F90

    r1236 r1279  
     1!
     2! $Id$
    13!
    24MODULE pbl_surface_mod
    … …  
    242244! pblT-----output-R- T au nveau HCL
    243245!
     246    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
     247    IMPLICIT NONE
     248
    244249    INCLUDE "indicesol.h"
    245250    INCLUDE "dimsoil.h"
    … …  
    460465!****************************************************************************************
    461466! Declarations specifiques pour le 1D. A reprendre
    462   REAL,SAVE    :: fsens,flat
    463   LOGICAL,SAVE :: ok_flux_surf=.FALSE.
    464 !$OMP THREADPRIVATE(fsens,flat,ok_flux_surf)
    465 
     467  REAL  :: fsens,flat
     468  LOGICAL :: ok_flux_surf=.FALSE.
     469  COMMON /flux_arp/fsens,flat,ok_flux_surf
    466470!****************************************************************************************
    467471! End of declarations
    … …  
    762766       ypsref(:) = ypaprs(:,1) 
    763767
    764 ! - Constant CO2 is copied to global grid
    765        r_co2_ppm(:) = co2_ppm
    766 
     768! - CO2 field on 2D grid to be sent to ORCHIDEE
     769!   Transform to compressed field
     770       IF (carbon_cycle_cpl) THEN
     771          DO i=1,knon
     772             r_co2_ppm(i) = co2_send(ni(i))
     773          END DO
     774       ELSE
     775          r_co2_ppm(:) = co2_ppm     ! Constant field
     776       END IF
    767777
    768778!****************************************************************************************

  • LMDZ4/trunk/libf/phylmd/phyetat0.F

    r1054 r1279  
    1919      USE iostart
    2020      USE write_field_phy
     21      USE infotrac
     22      USE traclmdz_mod,    ONLY : traclmdz_from_restart
     23      USE carbon_cycle_mod,ONLY : carbon_cycle_tr, carbon_cycle_cpl
     24
    2125      IMPLICIT none
    2226c======================================================================
    … …  
    4852      REAL run_off_lic_0(klon)
    4953      REAL fractint(klon)
     54      REAL trs(klon,nbtr)
    5055
    5156      CHARACTER*6 ocean_in
    … …  
    6267      INTEGER length
    6368      PARAMETER (length=100)
     69      INTEGER it, iiq
    6470      REAL tab_cntrl(length), tabcntr0(length)
    6571      CHARACTER*7 str7
    … …  
    101107         tab_cntrl(1)=dtime
    102108         tab_cntrl(2)=radpas
    103          co2_ppm_etat0      = tab_cntrl(3)
     109
     110c co2_ppm : value from the previous time step
     111         IF (carbon_cycle_tr .OR. carbon_cycle_cpl) THEN
     112            co2_ppm = tab_cntrl(3)
     113            RCO2    = co2_ppm * 1.0e-06  * 44.011/28.97
     114c ELSE : keep value from .def
     115         END IF
     116
     117c co2_ppm0 : initial value of atmospheric CO2 (from create_etat0_limit.e .def)
     118         co2_ppm0   = tab_cntrl(16)
     119
    104120         solaire_etat0      = tab_cntrl(4)
    105121         tab_cntrl(5)=iflag_con
    … …  
    853869c           f0(ig)=1.e-5
    854870c f0
    855       CALL get_field("f0",f0,found)
     871      CALL get_field("F0",f0,found)
    856872      IF (.NOT. found) THEN
    857873         PRINT*, "phyetat0: Le champ <f0> est absent"
    … …  
    983999      PRINT*,'(ecart-type) wake_fip:', xmin, xmax
    9841000c
     1001c Read and send field trs to traclmdz
     1002c
     1003      IF (type_trac == 'lmdz') THEN
     1004         DO it=1,nbtr
     1005            iiq=niadv(it+2)
     1006            CALL get_field("trs_"//tname(iiq),trs(:,it),found)
     1007            IF (.NOT. found) THEN
     1008               PRINT*,
     1009     $           "phyetat0: Le champ <trs_"//tname(iiq)//"> est absent"
     1010               PRINT*, "Depart legerement fausse. Mais je continue"
     1011               trs(:,it) = 0.
     1012            ENDIF
     1013            xmin = 1.0E+20
     1014            xmax = -1.0E+20
     1015            xmin = MINval(trs(:,it))
     1016            xmax = MAXval(trs(:,it))
     1017            PRINT*,"(ecart-type) trs_"//tname(iiq)//" :", xmin, xmax
     1018
     1019         END DO
     1020         
     1021         CALL traclmdz_from_restart(trs)
     1022      END IF
     1023
    9851024
    9861025c on ferme le fichier
    … …  
    10051044      CALL fonte_neige_init(run_off_lic_0)
    10061045
     1046
    10071047      RETURN
    10081048      END

  • LMDZ4/trunk/libf/phylmd/phyredem.F

    r1001 r1279  
    1212      USE phys_state_var_mod
    1313      USE iostart
     14      USE traclmdz_mod, ONLY : traclmdz_to_restart
     15      USE infotrac
    1416
    1517      IMPLICIT none
    … …  
    4244      REAL agesno(klon,nbsrf)
    4345      REAL run_off_lic_0(klon)
     46      REAL trs(klon,nbtr)
    4447c
    4548      INTEGER nid, nvarid, idim1, idim2, idim3
    … …  
    5255      CHARACTER (len=7) :: str7
    5356      CHARACTER (len=2) :: str2
    54 
     57      INTEGER           :: it, iiq
     58     
    5559c======================================================================
    5660c
    … …  
    7074         tab_cntrl(ierr) = 0.0
    7175      ENDDO
    72       tab_cntrl(1) = dtime
     76CC      tab_cntrl(1) = dtime
    7377      tab_cntrl(2) = radpas
     78c co2_ppm : current value of atmospheric CO2
    7479      tab_cntrl(3) = co2_ppm
    7580      tab_cntrl(4) = solaire
    … …  
    8691      tab_cntrl(14) = annee_ref
    8792      tab_cntrl(15) = itau_phy
     93
     94c co2_ppm0 : initial value of atmospheric CO2
     95      tab_cntrl(16) = co2_ppm0
    8896c
    8997      CALL put_var("controle","Parametres de controle",tab_cntrl)
    … …  
    311319      CALL put_field("WAKE_FIP","",wake_fip)
    312320
     321
     322! trs from traclmdz_mod
     323      IF (type_trac == 'lmdz') THEN
     324         CALL traclmdz_to_restart(trs)
     325         DO it=1,nbtr
     326            iiq=niadv(it+2)
     327            CALL put_field("trs_"//tname(iiq),"",trs(:,it))
     328         END DO
     329      END IF
     330
    313331      CALL close_restartphy
    314332!$OMP BARRIER

  • LMDZ4/trunk/libf/phylmd/phys_local_var_mod.F90

    r1146 r1279  
     1!
     2! $Id$
     3!
    14      MODULE phys_local_var_mod
     5
    26! Variables locales pour effectuer les appels en serie
    37!======================================================================
    … …  
    6670      REAL, SAVE, ALLOCATABLE :: d_ts(:,:), d_tr(:,:,:)
    6771      !$OMP THREADPRIVATE(d_ts, d_tr)
     72
     73! diagnostique pour le rayonnement
     74      REAL, SAVE, ALLOCATABLE :: topswad_aero(:),  solswad_aero(:)      ! diag
     75      !$OMP THREADPRIVATE(topswad_aero,solswad_aero)
     76      REAL, SAVE, ALLOCATABLE :: topswai_aero(:),  solswai_aero(:)      ! diag
     77      !$OMP THREADPRIVATE(topswai_aero,solswai_aero)
     78      REAL, SAVE, ALLOCATABLE :: topswad0_aero(:), solswad0_aero(:)     ! diag
     79      !$OMP THREADPRIVATE(topswad0_aero,solswad0_aero)
     80      REAL, SAVE, ALLOCATABLE :: topsw_aero(:,:),  solsw_aero(:,:)      ! diag
     81      !$OMP THREADPRIVATE(topsw_aero,solsw_aero)
     82      REAL, SAVE, ALLOCATABLE :: topsw0_aero(:,:), solsw0_aero(:,:)     ! diag
     83      !$OMP THREADPRIVATE(topsw0_aero,solsw0_aero)
     84      REAL, SAVE, ALLOCATABLE :: topswcf_aero(:,:),  solswcf_aero(:,:)  ! diag
     85      !$OMP THREADPRIVATE(topswcf_aero,solswcf_aero)
     86      REAL, SAVE, ALLOCATABLE :: tausum_aero(:,:,:)
     87      !$OMP THREADPRIVATE(tausum_aero)
     88      REAL, SAVE, ALLOCATABLE :: tau3d_aero(:,:,:,:)
     89      !$OMP THREADPRIVATE(tau3d_aero)
     90
    6891CONTAINS
    6992
    … …  
    7295use dimphy
    7396use infotrac, ONLY : nbtr
     97USE aero_mod
     98
    7499IMPLICIT NONE
    75100#include "indicesol.h"
    … …  
    97122      allocate(d_u_lif(klon,klev),d_v_lif(klon,klev))
    98123      allocate(d_ts(klon,klev), d_tr(klon,klev,nbtr))
     124      allocate(topswad_aero(klon), solswad_aero(klon))
     125      allocate(topswai_aero(klon), solswai_aero(klon))
     126      allocate(topswad0_aero(klon), solswad0_aero(klon))
     127      allocate(topsw_aero(klon,naero_grp), solsw_aero(klon,naero_grp))
     128      allocate(topsw0_aero(klon,naero_grp), solsw0_aero(klon,naero_grp))
     129      allocate(topswcf_aero(klon,3), solswcf_aero(klon,3))
     130      allocate(d_u_hin(klon,klev),d_v_hin(klon,klev),d_t_hin(klon,klev))
     131      allocate(tausum_aero(klon,nwave,naero_spc))
     132      allocate(tau3d_aero(klon,klev,nwave,naero_spc))
     133
    99134END SUBROUTINE phys_local_var_init
    100135
    … …  
    127162      deallocate(d_u_lif,d_v_lif)
    128163      deallocate(d_ts, d_tr)
     164      deallocate(topswad_aero,solswad_aero)
     165      deallocate(topswai_aero,solswai_aero)
     166      deallocate(topswad0_aero,solswad0_aero)
     167      deallocate(topsw_aero,solsw_aero)
     168      deallocate(topsw0_aero,solsw0_aero)
     169      deallocate(topswcf_aero,solswcf_aero)
     170      deallocate(tausum_aero)
     171      deallocate(tau3d_aero)
     172      deallocate(d_u_hin,d_v_hin,d_t_hin)
     173
    129174END SUBROUTINE phys_local_var_end
    130175

  • LMDZ4/trunk/libf/phylmd/phys_output_mod.F90

    r1146 r1279  
     1!
     2! $Id$
     3!
    14! Abderrahmane 12 2007
    25!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    1922   integer, dimension(nfiles), save             :: lev_files
    2023   integer, dimension(nfiles), save             :: nid_files
    21 
     24!!$OMP THREADPRIVATE(clef_files, lev_files,nid_files)
     25 
    2226   integer, dimension(nfiles), private, save :: nhorim, nvertm
    23    real, dimension(nfiles), private, save                :: zstophym, zoutm
     27   integer, dimension(nfiles), private, save :: nvertap, nvertbp, nvertAlt
     28!   integer, dimension(nfiles), private, save :: nvertp0
     29   real, dimension(nfiles), private, save                :: zoutm
     30   real,                    private, save                :: zdtime
    2431   CHARACTER(len=20), dimension(nfiles), private, save   :: type_ecri
     32!$OMP THREADPRIVATE(nhorim, nvertm, zoutm,zdtime,type_ecri)
    2533
    2634!   integer, save                     :: nid_hf3d
    … …  
    3947  END TYPE ctrl_out
    4048
     49!!! Comosentes de la coordonnee sigma-hybride
     50!!! Ap et Bp
     51  type(ctrl_out),save :: o_Ahyb         = ctrl_out((/ 1, 1, 1, 1, 1 /), 'Ap')
     52  type(ctrl_out),save :: o_Bhyb         = ctrl_out((/ 1, 1, 1, 1, 1 /), 'Bp')
     53  type(ctrl_out),save :: o_Alt          = ctrl_out((/ 1, 1, 1, 1, 1 /), 'Alt')
    4154
    4255!!! 1D
    43   type(ctrl_out) :: o_phis         = ctrl_out((/ 1, 1, 10, 1, 1 /), 'phis')
    44   type(ctrl_out) :: o_aire         = ctrl_out((/ 1, 1, 10,  1, 1 /),'aire')
    45   type(ctrl_out) :: o_contfracATM  = ctrl_out((/ 10, 1,  1, 10, 10 /),'contfracATM')
    46   type(ctrl_out) :: o_contfracOR   = ctrl_out((/ 10, 1,  1, 10, 10 /),'contfracOR')
    47   type(ctrl_out) :: o_aireTER      = ctrl_out((/ 10, 10, 1, 10, 10 /),'aireTER')
     56  type(ctrl_out),save :: o_phis         = ctrl_out((/ 1, 1, 10, 1, 1 /), 'phis')
     57  type(ctrl_out),save :: o_aire         = ctrl_out((/ 1, 1, 10,  1, 1 /),'aire')
     58  type(ctrl_out),save :: o_contfracATM  = ctrl_out((/ 10, 1,  1, 10, 10 /),'contfracATM')
     59  type(ctrl_out),save :: o_contfracOR   = ctrl_out((/ 10, 1,  1, 10, 10 /),'contfracOR')
     60  type(ctrl_out),save :: o_aireTER      = ctrl_out((/ 10, 10, 1, 10, 10 /),'aireTER')
    4861 
    4962!!! 2D
    50   type(ctrl_out) :: o_flat         = ctrl_out((/ 10, 1, 10, 10, 1 /),'flat')
    51   type(ctrl_out) :: o_slp          = ctrl_out((/ 1, 1, 1, 10, 1 /),'slp')
    52   type(ctrl_out) :: o_tsol         = ctrl_out((/ 1, 1, 1, 1, 1 /),'tsol')
    53   type(ctrl_out) :: o_t2m          = ctrl_out((/ 1, 1, 1, 1, 1 /),'t2m')
    54   type(ctrl_out) :: o_t2m_min      = ctrl_out((/ 1, 1, 10, 10, 10 /),'t2m_min')
    55   type(ctrl_out) :: o_t2m_max      = ctrl_out((/ 1, 1, 10, 10, 10 /),'t2m_max')
    56   type(ctrl_out),dimension(4) :: o_t2m_srf      = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'t2m_ter'), &
     63  type(ctrl_out),save :: o_flat         = ctrl_out((/ 10, 1, 10, 10, 1 /),'flat')
     64  type(ctrl_out),save :: o_slp          = ctrl_out((/ 1, 1, 1, 10, 1 /),'slp')
     65  type(ctrl_out),save :: o_tsol         = ctrl_out((/ 1, 1, 1, 1, 1 /),'tsol')
     66  type(ctrl_out),save :: o_t2m          = ctrl_out((/ 1, 1, 1, 1, 1 /),'t2m')
     67  type(ctrl_out),save :: o_t2m_min      = ctrl_out((/ 1, 1, 10, 10, 10 /),'t2m_min')
     68  type(ctrl_out),save :: o_t2m_max      = ctrl_out((/ 1, 1, 10, 10, 10 /),'t2m_max')
     69  type(ctrl_out),save,dimension(4) :: o_t2m_srf      = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'t2m_ter'), &
    5770                                                 ctrl_out((/ 10, 4, 10, 10, 10 /),'t2m_lic'), &
    5871                                                 ctrl_out((/ 10, 4, 10, 10, 10 /),'t2m_oce'), &
    5972                                                 ctrl_out((/ 10, 4, 10, 10, 10 /),'t2m_sic') /)
    6073
    61   type(ctrl_out) :: o_wind10m      = ctrl_out((/ 1, 1, 1, 10, 10 /),'wind10m')
    62   type(ctrl_out) :: o_wind10max    = ctrl_out((/ 10, 1, 10, 10, 10 /),'wind10max')
    63   type(ctrl_out) :: o_sicf         = ctrl_out((/ 1, 1, 10, 10, 10 /),'sicf')
    64   type(ctrl_out) :: o_q2m          = ctrl_out((/ 1, 1, 1, 1, 1 /),'q2m')
    65   type(ctrl_out) :: o_u10m         = ctrl_out((/ 1, 1, 1, 1, 1 /),'u10m')
    66   type(ctrl_out) :: o_v10m         = ctrl_out((/ 1, 1, 1, 1, 1 /),'v10m')
    67   type(ctrl_out) :: o_psol         = ctrl_out((/ 1, 1, 1, 1, 1 /),'psol')
    68   type(ctrl_out) :: o_qsurf        = ctrl_out((/ 1, 10, 10, 10, 10 /),'qsurf')
    69 
    70   type(ctrl_out),dimension(4) :: o_u10m_srf     = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'u10m_ter'), &
     74  type(ctrl_out),save :: o_wind10m      = ctrl_out((/ 1, 1, 1, 10, 10 /),'wind10m')
     75  type(ctrl_out),save :: o_wind10max    = ctrl_out((/ 10, 1, 10, 10, 10 /),'wind10max')
     76  type(ctrl_out),save :: o_sicf         = ctrl_out((/ 1, 1, 10, 10, 10 /),'sicf')
     77  type(ctrl_out),save :: o_q2m          = ctrl_out((/ 1, 1, 1, 1, 1 /),'q2m')
     78  type(ctrl_out),save :: o_u10m         = ctrl_out((/ 1, 1, 1, 1, 1 /),'u10m')
     79  type(ctrl_out),save :: o_v10m         = ctrl_out((/ 1, 1, 1, 1, 1 /),'v10m')
     80  type(ctrl_out),save :: o_psol         = ctrl_out((/ 1, 1, 1, 1, 1 /),'psol')
     81  type(ctrl_out),save :: o_qsurf        = ctrl_out((/ 1, 10, 10, 10, 10 /),'qsurf')
     82
     83  type(ctrl_out),save,dimension(4) :: o_u10m_srf     = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'u10m_ter'), &
    7184                                              ctrl_out((/ 10, 4, 10, 10, 10 /),'u10m_lic'), &
    7285                                              ctrl_out((/ 10, 4, 10, 10, 10 /),'u10m_oce'), &
    7386                                              ctrl_out((/ 10, 4, 10, 10, 10 /),'u10m_sic') /)
    7487
    75   type(ctrl_out),dimension(4) :: o_v10m_srf     = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'v10m_ter'), &
     88  type(ctrl_out),save,dimension(4) :: o_v10m_srf     = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'v10m_ter'), &
    7689                                              ctrl_out((/ 10, 4, 10, 10, 10 /),'v10m_lic'), &
    7790                                              ctrl_out((/ 10, 4, 10, 10, 10 /),'v10m_oce'), &
    7891                                              ctrl_out((/ 10, 4, 10, 10, 10 /),'v10m_sic') /)
    7992
    80   type(ctrl_out) :: o_qsol         = ctrl_out((/ 1, 10, 10, 1, 1 /),'qsol')
    81 
    82   type(ctrl_out) :: o_ndayrain     = ctrl_out((/ 1, 10, 10, 10, 10 /),'ndayrain')
    83   type(ctrl_out) :: o_precip       = ctrl_out((/ 1, 1, 1, 1, 1 /),'precip')
    84   type(ctrl_out) :: o_plul         = ctrl_out((/ 1, 1, 1, 1, 10 /),'plul')
    85 
    86   type(ctrl_out) :: o_pluc         = ctrl_out((/ 1, 1, 1, 1, 10 /),'pluc')
    87   type(ctrl_out) :: o_snow         = ctrl_out((/ 1, 1, 10, 1, 10 /),'snow')
    88   type(ctrl_out) :: o_evap         = ctrl_out((/ 1, 1, 10, 1, 10 /),'evap')
    89   type(ctrl_out) :: o_tops         = ctrl_out((/ 1, 1, 10, 10, 10 /),'tops')
    90   type(ctrl_out) :: o_tops0        = ctrl_out((/ 1, 5, 10, 10, 10 /),'tops0')
    91   type(ctrl_out) :: o_topl         = ctrl_out((/ 1, 1, 10, 1, 10 /),'topl')
    92   type(ctrl_out) :: o_topl0        = ctrl_out((/ 1, 5, 10, 10, 10 /),'topl0')
    93   type(ctrl_out) :: o_SWupTOA      = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWupTOA')
    94   type(ctrl_out) :: o_SWupTOAclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWupTOAclr')
    95   type(ctrl_out) :: o_SWdnTOA      = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWdnTOA')
    96   type(ctrl_out) :: o_SWdnTOAclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWdnTOAclr')
    97   type(ctrl_out) :: o_SWup200      = ctrl_out((/ 1, 10, 10, 10, 10 /),'SWup200')
    98   type(ctrl_out) :: o_SWup200clr   = ctrl_out((/ 10, 1, 10, 10, 10 /),'SWup200clr')
    99   type(ctrl_out) :: o_SWdn200      = ctrl_out((/ 1, 10, 10, 10, 10 /),'SWdn200')
    100   type(ctrl_out) :: o_SWdn200clr   = ctrl_out((/ 10, 1, 10, 10, 10 /),'SWdn200clr')
     93  type(ctrl_out),save :: o_qsol         = ctrl_out((/ 1, 10, 10, 1, 1 /),'qsol')
     94
     95  type(ctrl_out),save :: o_ndayrain     = ctrl_out((/ 1, 10, 10, 10, 10 /),'ndayrain')
     96  type(ctrl_out),save :: o_precip       = ctrl_out((/ 1, 1, 1, 1, 1 /),'precip')
     97  type(ctrl_out),save :: o_plul         = ctrl_out((/ 1, 1, 1, 1, 10 /),'plul')
     98
     99  type(ctrl_out),save :: o_pluc         = ctrl_out((/ 1, 1, 1, 1, 10 /),'pluc')
     100  type(ctrl_out),save :: o_snow         = ctrl_out((/ 1, 1, 10, 1, 10 /),'snow')
     101  type(ctrl_out),save :: o_evap         = ctrl_out((/ 1, 1, 10, 1, 10 /),'evap')
     102  type(ctrl_out),save :: o_tops         = ctrl_out((/ 1, 1, 10, 10, 10 /),'tops')
     103  type(ctrl_out),save :: o_tops0        = ctrl_out((/ 1, 5, 10, 10, 10 /),'tops0')
     104  type(ctrl_out),save :: o_topl         = ctrl_out((/ 1, 1, 10, 1, 10 /),'topl')
     105  type(ctrl_out),save :: o_topl0        = ctrl_out((/ 1, 5, 10, 10, 10 /),'topl0')
     106  type(ctrl_out),save :: o_SWupTOA      = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWupTOA')
     107  type(ctrl_out),save :: o_SWupTOAclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWupTOAclr')
     108  type(ctrl_out),save :: o_SWdnTOA      = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWdnTOA')
     109  type(ctrl_out),save :: o_SWdnTOAclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWdnTOAclr')
     110  type(ctrl_out),save :: o_SWup200      = ctrl_out((/ 1, 10, 10, 10, 10 /),'SWup200')
     111  type(ctrl_out),save :: o_SWup200clr   = ctrl_out((/ 10, 1, 10, 10, 10 /),'SWup200clr')
     112  type(ctrl_out),save :: o_SWdn200      = ctrl_out((/ 1, 10, 10, 10, 10 /),'SWdn200')
     113  type(ctrl_out),save :: o_SWdn200clr   = ctrl_out((/ 10, 1, 10, 10, 10 /),'SWdn200clr')
    101114
    102115! arajouter
    103 !  type(ctrl_out) :: o_LWupTOA     = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWupTOA')
    104 !  type(ctrl_out) :: o_LWupTOAclr  = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWupTOAclr')
    105 !  type(ctrl_out) :: o_LWdnTOA     = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWdnTOA')
    106 !  type(ctrl_out) :: o_LWdnTOAclr  = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWdnTOAclr')
    107 
    108   type(ctrl_out) :: o_LWup200      = ctrl_out((/ 1, 10, 10, 10, 10 /),'LWup200')
    109   type(ctrl_out) :: o_LWup200clr   = ctrl_out((/ 1, 10, 10, 10, 10 /),'LWup200clr')
    110   type(ctrl_out) :: o_LWdn200      = ctrl_out((/ 1, 10, 10, 10, 10 /),'LWdn200')
    111   type(ctrl_out) :: o_LWdn200clr   = ctrl_out((/ 1, 10, 10, 10, 10 /),'LWdn200clr')
    112   type(ctrl_out) :: o_sols         = ctrl_out((/ 1, 1, 10, 1, 10 /),'sols')
    113   type(ctrl_out) :: o_sols0        = ctrl_out((/ 1, 5, 10, 10, 10 /),'sols0')
    114   type(ctrl_out) :: o_soll         = ctrl_out((/ 1, 1, 10, 1, 10 /),'soll')
    115   type(ctrl_out) :: o_soll0        = ctrl_out((/ 1, 5, 10, 10, 10 /),'soll0')
    116   type(ctrl_out) :: o_radsol       = ctrl_out((/ 1, 1, 10, 10, 10 /),'radsol')
    117   type(ctrl_out) :: o_SWupSFC      = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWupSFC')
    118   type(ctrl_out) :: o_SWupSFCclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWupSFCclr')
    119   type(ctrl_out) :: o_SWdnSFC      = ctrl_out((/ 1, 1, 10, 10, 10 /),'SWdnSFC')
    120   type(ctrl_out) :: o_SWdnSFCclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWdnSFCclr')
    121   type(ctrl_out) :: o_LWupSFC      = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWupSFC')
    122   type(ctrl_out) :: o_LWupSFCclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWupSFCclr')
    123   type(ctrl_out) :: o_LWdnSFC      = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWdnSFC')
    124   type(ctrl_out) :: o_LWdnSFCclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWdnSFCclr')
    125   type(ctrl_out) :: o_bils         = ctrl_out((/ 1, 2, 10, 1, 10 /),'bils')
    126   type(ctrl_out) :: o_sens         = ctrl_out((/ 1, 1, 10, 1, 1 /),'sens')
    127   type(ctrl_out) :: o_fder         = ctrl_out((/ 1, 2, 10, 1, 10 /),'fder')
    128   type(ctrl_out) :: o_ffonte       = ctrl_out((/ 1, 10, 10, 10, 10 /),'ffonte')
    129   type(ctrl_out) :: o_fqcalving    = ctrl_out((/ 1, 10, 10, 10, 10 /),'fqcalving')
    130   type(ctrl_out) :: o_fqfonte      = ctrl_out((/ 1, 10, 10, 10, 10 /),'fqfonte')
    131 
    132   type(ctrl_out),dimension(4) :: o_taux_srf     = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'taux_ter'), &
     116!  type(ctrl_out),save :: o_LWupTOA     = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWupTOA')
     117!  type(ctrl_out),save :: o_LWupTOAclr  = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWupTOAclr')
     118!  type(ctrl_out),save :: o_LWdnTOA     = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWdnTOA')
     119!  type(ctrl_out),save :: o_LWdnTOAclr  = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWdnTOAclr')
     120
     121  type(ctrl_out),save :: o_LWup200      = ctrl_out((/ 1, 10, 10, 10, 10 /),'LWup200')
     122  type(ctrl_out),save :: o_LWup200clr   = ctrl_out((/ 1, 10, 10, 10, 10 /),'LWup200clr')
     123  type(ctrl_out),save :: o_LWdn200      = ctrl_out((/ 1, 10, 10, 10, 10 /),'LWdn200')
     124  type(ctrl_out),save :: o_LWdn200clr   = ctrl_out((/ 1, 10, 10, 10, 10 /),'LWdn200clr')
     125  type(ctrl_out),save :: o_sols         = ctrl_out((/ 1, 1, 10, 1, 10 /),'sols')
     126  type(ctrl_out),save :: o_sols0        = ctrl_out((/ 1, 5, 10, 10, 10 /),'sols0')
     127  type(ctrl_out),save :: o_soll         = ctrl_out((/ 1, 1, 10, 1, 10 /),'soll')
     128  type(ctrl_out),save :: o_soll0        = ctrl_out((/ 1, 5, 10, 10, 10 /),'soll0')
     129  type(ctrl_out),save :: o_radsol       = ctrl_out((/ 1, 1, 10, 10, 10 /),'radsol')
     130  type(ctrl_out),save :: o_SWupSFC      = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWupSFC')
     131  type(ctrl_out),save :: o_SWupSFCclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWupSFCclr')
     132  type(ctrl_out),save :: o_SWdnSFC      = ctrl_out((/ 1, 1, 10, 10, 10 /),'SWdnSFC')
     133  type(ctrl_out),save :: o_SWdnSFCclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWdnSFCclr')
     134  type(ctrl_out),save :: o_LWupSFC      = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWupSFC')
     135  type(ctrl_out),save :: o_LWupSFCclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWupSFCclr')
     136  type(ctrl_out),save :: o_LWdnSFC      = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWdnSFC')
     137  type(ctrl_out),save :: o_LWdnSFCclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWdnSFCclr')
     138  type(ctrl_out),save :: o_bils         = ctrl_out((/ 1, 2, 10, 1, 10 /),'bils')
     139  type(ctrl_out),save :: o_sens         = ctrl_out((/ 1, 1, 10, 1, 1 /),'sens')
     140  type(ctrl_out),save :: o_fder         = ctrl_out((/ 1, 2, 10, 1, 10 /),'fder')
     141  type(ctrl_out),save :: o_ffonte       = ctrl_out((/ 1, 10, 10, 10, 10 /),'ffonte')
     142  type(ctrl_out),save :: o_fqcalving    = ctrl_out((/ 1, 10, 10, 10, 10 /),'fqcalving')
     143  type(ctrl_out),save :: o_fqfonte      = ctrl_out((/ 1, 10, 10, 10, 10 /),'fqfonte')
     144
     145  type(ctrl_out),save,dimension(4) :: o_taux_srf     = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'taux_ter'), &
    133146                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'taux_lic'), &
    134147                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'taux_oce'), &
    135148                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'taux_sic') /)
    136149
    137   type(ctrl_out),dimension(4) :: o_tauy_srf     = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'tauy_ter'), &
     150  type(ctrl_out),save,dimension(4) :: o_tauy_srf     = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'tauy_ter'), &
    138151                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'tauy_lic'), &
    139152                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'tauy_oce'), &
    … …  
    141154
    142155
    143   type(ctrl_out),dimension(4) :: o_pourc_srf    = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'pourc_ter'), &
     156  type(ctrl_out),save,dimension(4) :: o_pourc_srf    = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'pourc_ter'), &
    144157                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'pourc_lic'), &
    145158                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'pourc_oce'), &
    146159                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'pourc_sic') /)     
    147160
    148   type(ctrl_out),dimension(4) :: o_fract_srf    = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'fract_ter'), &
     161  type(ctrl_out),save,dimension(4) :: o_fract_srf    = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'fract_ter'), &
    149162                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'fract_lic'), &
    150163                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'fract_oce'), &
    151164                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'fract_sic') /)
    152165
    153   type(ctrl_out),dimension(4) :: o_tsol_srf     = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'tsol_ter'), &
     166  type(ctrl_out),save,dimension(4) :: o_tsol_srf     = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'tsol_ter'), &
    154167                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'tsol_lic'), &
    155168                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'tsol_oce'), &
    156169                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'tsol_sic') /)
    157170
    158   type(ctrl_out),dimension(4) :: o_sens_srf     = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'sens_ter'), &
     171  type(ctrl_out),save,dimension(4) :: o_sens_srf     = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'sens_ter'), &
    159172                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'sens_lic'), &
    160173                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'sens_oce'), &
    161174                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'sens_sic') /)
    162175
    163   type(ctrl_out),dimension(4) :: o_lat_srf      = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'lat_ter'), &
     176  type(ctrl_out),save,dimension(4) :: o_lat_srf      = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'lat_ter'), &
    164177                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'lat_lic'), &
    165178                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'lat_oce'), &
    166179                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'lat_sic') /)
    167180
    168   type(ctrl_out),dimension(4) :: o_flw_srf      = (/ ctrl_out((/ 1, 10, 10, 10, 10 /),'flw_ter'), &
     181  type(ctrl_out),save,dimension(4) :: o_flw_srf      = (/ ctrl_out((/ 1, 10, 10, 10, 10 /),'flw_ter'), &
    169182                                                 ctrl_out((/ 1, 10, 10, 10, 10 /),'flw_lic'), &
    170183                                                 ctrl_out((/ 1, 10, 10, 10, 10 /),'flw_oce'), &
    171184                                                 ctrl_out((/ 1, 10, 10, 10, 10 /),'flw_sic') /)
    172185                                                 
    173   type(ctrl_out),dimension(4) :: o_fsw_srf      = (/ ctrl_out((/ 1, 10, 10, 10, 10 /),'fsw_ter'), &
     186  type(ctrl_out),save,dimension(4) :: o_fsw_srf      = (/ ctrl_out((/ 1, 10, 10, 10, 10 /),'fsw_ter'), &
    174187                                                  ctrl_out((/ 1, 10, 10, 10, 10 /),'fsw_lic'), &
    175188                                                  ctrl_out((/ 1, 10, 10, 10, 10 /),'fsw_oce'), &
    176189                                                  ctrl_out((/ 1, 10, 10, 10, 10 /),'fsw_sic') /)
    177190
    178   type(ctrl_out),dimension(4) :: o_wbils_srf    = (/ ctrl_out((/ 1, 10, 10, 10, 10 /),'wbils_ter'), &
     191  type(ctrl_out),save,dimension(4) :: o_wbils_srf    = (/ ctrl_out((/ 1, 10, 10, 10, 10 /),'wbils_ter'), &
    179192                                                 ctrl_out((/ 1, 10, 10, 10, 10 /),'wbils_lic'), &
    180193                                                 ctrl_out((/ 1, 10, 10, 10, 10 /),'wbils_oce'), &
    181194                                                 ctrl_out((/ 1, 10, 10, 10, 10 /),'wbils_sic') /)
    182195
    183   type(ctrl_out),dimension(4) :: o_wbilo_srf    = (/ ctrl_out((/ 1, 10, 10, 10, 10 /),'wbilo_ter'), &
     196  type(ctrl_out),save,dimension(4) :: o_wbilo_srf    = (/ ctrl_out((/ 1, 10, 10, 10, 10 /),'wbilo_ter'), &
    184197                                                     ctrl_out((/ 1, 10, 10, 10, 10 /),'wbilo_lic'), &
    185198                                                 ctrl_out((/ 1, 10, 10, 10, 10 /),'wbilo_oce'), &
    … …  
    187200
    188201
    189   type(ctrl_out) :: o_cdrm         = ctrl_out((/ 1, 10, 10, 1, 10 /),'cdrm')
    190   type(ctrl_out) :: o_cdrh         = ctrl_out((/ 1, 10, 10, 1, 10 /),'cdrh')
    191   type(ctrl_out) :: o_cldl         = ctrl_out((/ 1, 1, 10, 10, 10 /),'cldl')
    192   type(ctrl_out) :: o_cldm         = ctrl_out((/ 1, 1, 10, 10, 10 /),'cldm')
    193   type(ctrl_out) :: o_cldh         = ctrl_out((/ 1, 1, 10, 10, 10 /),'cldh')
    194   type(ctrl_out) :: o_cldt         = ctrl_out((/ 1, 1, 2, 10, 10 /),'cldt')
    195   type(ctrl_out) :: o_cldq         = ctrl_out((/ 1, 1, 10, 10, 10 /),'cldq')
    196   type(ctrl_out) :: o_lwp          = ctrl_out((/ 1, 5, 10, 10, 10 /),'lwp')
    197   type(ctrl_out) :: o_iwp          = ctrl_out((/ 1, 5, 10, 10, 10 /),'iwp')
    198   type(ctrl_out) :: o_ue           = ctrl_out((/ 1, 10, 10, 10, 10 /),'ue')
    199   type(ctrl_out) :: o_ve           = ctrl_out((/ 1, 10, 10, 10, 10 /),'ve')
    200   type(ctrl_out) :: o_uq           = ctrl_out((/ 1, 10, 10, 10, 10 /),'uq')
    201   type(ctrl_out) :: o_vq           = ctrl_out((/ 1, 10, 10, 10, 10 /),'vq')
     202  type(ctrl_out),save :: o_cdrm         = ctrl_out((/ 1, 10, 10, 1, 10 /),'cdrm')
     203  type(ctrl_out),save :: o_cdrh         = ctrl_out((/ 1, 10, 10, 1, 10 /),'cdrh')
     204  type(ctrl_out),save :: o_cldl         = ctrl_out((/ 1, 1, 10, 10, 10 /),'cldl')
     205  type(ctrl_out),save :: o_cldm         = ctrl_out((/ 1, 1, 10, 10, 10 /),'cldm')
     206  type(ctrl_out),save :: o_cldh         = ctrl_out((/ 1, 1, 10, 10, 10 /),'cldh')
     207  type(ctrl_out),save :: o_cldt         = ctrl_out((/ 1, 1, 2, 10, 10 /),'cldt')
     208  type(ctrl_out),save :: o_cldq         = ctrl_out((/ 1, 1, 10, 10, 10 /),'cldq')
     209  type(ctrl_out),save :: o_lwp          = ctrl_out((/ 1, 5, 10, 10, 10 /),'lwp')
     210  type(ctrl_out),save :: o_iwp          = ctrl_out((/ 1, 5, 10, 10, 10 /),'iwp')
     211  type(ctrl_out),save :: o_ue           = ctrl_out((/ 1, 10, 10, 10, 10 /),'ue')
     212  type(ctrl_out),save :: o_ve           = ctrl_out((/ 1, 10, 10, 10, 10 /),'ve')
     213  type(ctrl_out),save :: o_uq           = ctrl_out((/ 1, 10, 10, 10, 10 /),'uq')
     214  type(ctrl_out),save :: o_vq           = ctrl_out((/ 1, 10, 10, 10, 10 /),'vq')
    202215 
    203   type(ctrl_out) :: o_cape         = ctrl_out((/ 1, 10, 10, 10, 10 /),'cape')
    204   type(ctrl_out) :: o_pbase        = ctrl_out((/ 1, 10, 10, 10, 10 /),'pbase')
    205   type(ctrl_out) :: o_ptop         = ctrl_out((/ 1, 4, 10, 10, 10 /),'ptop')
    206   type(ctrl_out) :: o_fbase        = ctrl_out((/ 1, 10, 10, 10, 10 /),'fbase')
    207   type(ctrl_out) :: o_prw          = ctrl_out((/ 1, 1, 10, 10, 10 /),'prw')
    208 
    209   type(ctrl_out) :: o_s_pblh       = ctrl_out((/ 1, 10, 10, 1, 1 /),'s_pblh')
    210   type(ctrl_out) :: o_s_pblt       = ctrl_out((/ 1, 10, 10, 1, 1 /),'s_pblt')
    211   type(ctrl_out) :: o_s_lcl        = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_lcl')
    212   type(ctrl_out) :: o_s_capCL      = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_capCL')
    213   type(ctrl_out) :: o_s_oliqCL     = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_oliqCL')
    214   type(ctrl_out) :: o_s_cteiCL     = ctrl_out((/ 1, 10, 10, 1, 1 /),'s_cteiCL')
    215   type(ctrl_out) :: o_s_therm      = ctrl_out((/ 1, 10, 10, 1, 1 /),'s_therm')
    216   type(ctrl_out) :: o_s_trmb1      = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_trmb1')
    217   type(ctrl_out) :: o_s_trmb2      = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_trmb2')
    218   type(ctrl_out) :: o_s_trmb3      = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_trmb3')
    219 
    220   type(ctrl_out) :: o_slab_bils    = ctrl_out((/ 1, 1, 10, 10, 10 /),'slab_bils_oce')
    221 
    222   type(ctrl_out) :: o_ale_bl       = ctrl_out((/ 1, 1, 1, 1, 10 /),'ale_bl')
    223   type(ctrl_out) :: o_alp_bl       = ctrl_out((/ 1, 1, 1, 1, 10 /),'alp_bl')
    224   type(ctrl_out) :: o_ale_wk       = ctrl_out((/ 1, 1, 1, 1, 10 /),'ale_wk')
    225   type(ctrl_out) :: o_alp_wk       = ctrl_out((/ 1, 1, 1, 1, 10 /),'alp_wk')
    226 
    227   type(ctrl_out) :: o_ale          = ctrl_out((/ 1, 1, 1, 1, 10 /),'ale')
    228   type(ctrl_out) :: o_alp          = ctrl_out((/ 1, 1, 1, 1, 10 /),'alp')
    229   type(ctrl_out) :: o_cin          = ctrl_out((/ 1, 1, 1, 1, 10 /),'cin')
    230   type(ctrl_out) :: o_wape         = ctrl_out((/ 1, 1, 1, 1, 10 /),'wape')
     216  type(ctrl_out),save :: o_cape         = ctrl_out((/ 1, 10, 10, 10, 10 /),'cape')
     217  type(ctrl_out),save :: o_pbase        = ctrl_out((/ 1, 10, 10, 10, 10 /),'pbase')
     218  type(ctrl_out),save :: o_ptop         = ctrl_out((/ 1, 4, 10, 10, 10 /),'ptop')
     219  type(ctrl_out),save :: o_fbase        = ctrl_out((/ 1, 10, 10, 10, 10 /),'fbase')
     220  type(ctrl_out),save :: o_prw          = ctrl_out((/ 1, 1, 10, 10, 10 /),'prw')
     221
     222  type(ctrl_out),save :: o_s_pblh       = ctrl_out((/ 1, 10, 10, 1, 1 /),'s_pblh')
     223  type(ctrl_out),save :: o_s_pblt       = ctrl_out((/ 1, 10, 10, 1, 1 /),'s_pblt')
     224  type(ctrl_out),save :: o_s_lcl        = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_lcl')
     225  type(ctrl_out),save :: o_s_capCL      = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_capCL')
     226  type(ctrl_out),save :: o_s_oliqCL     = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_oliqCL')
     227  type(ctrl_out),save :: o_s_cteiCL     = ctrl_out((/ 1, 10, 10, 1, 1 /),'s_cteiCL')
     228  type(ctrl_out),save :: o_s_therm      = ctrl_out((/ 1, 10, 10, 1, 1 /),'s_therm')
     229  type(ctrl_out),save :: o_s_trmb1      = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_trmb1')
     230  type(ctrl_out),save :: o_s_trmb2      = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_trmb2')
     231  type(ctrl_out),save :: o_s_trmb3      = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_trmb3')
     232
     233  type(ctrl_out),save :: o_slab_bils    = ctrl_out((/ 1, 1, 10, 10, 10 /),'slab_bils_oce')
     234
     235  type(ctrl_out),save :: o_ale_bl       = ctrl_out((/ 1, 1, 1, 1, 10 /),'ale_bl')
     236  type(ctrl_out),save :: o_alp_bl       = ctrl_out((/ 1, 1, 1, 1, 10 /),'alp_bl')
     237  type(ctrl_out),save :: o_ale_wk       = ctrl_out((/ 1, 1, 1, 1, 10 /),'ale_wk')
     238  type(ctrl_out),save :: o_alp_wk       = ctrl_out((/ 1, 1, 1, 1, 10 /),'alp_wk')
     239
     240  type(ctrl_out),save :: o_ale          = ctrl_out((/ 1, 1, 1, 1, 10 /),'ale')
     241  type(ctrl_out),save :: o_alp          = ctrl_out((/ 1, 1, 1, 1, 10 /),'alp')
     242  type(ctrl_out),save :: o_cin          = ctrl_out((/ 1, 1, 1, 1, 10 /),'cin')
     243  type(ctrl_out),save :: o_wape         = ctrl_out((/ 1, 1, 1, 1, 10 /),'wape')
    231244
    232245
    233246! Champs interpolles sur des niveaux de pression ??? a faire correctement
    234 ! if=1 on ecrit u v w phi sur 850 700 500 200 au niv 1
    235 ! if=2 on ecrit w et ph 500 seulement au niv 1
    236 !        et u v sur 850 700 500 200
    237 ! if=3 on ecrit ph a 500 seulement au niv 1
    238 !      on ecrit u v t q a 850 700 500 200 au niv 3
    239 !      on ecrit ph  a 500   au niv 3
    240 
    241247                                             
    242   type(ctrl_out),dimension(4) :: o_uSTDlevs     = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'u850'), &
     248  type(ctrl_out),save,dimension(6) :: o_uSTDlevs     = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'u850'), &
    243249                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'u700'), &
    244250                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'u500'), &
    245                                                      ctrl_out((/ 1, 1, 3, 10, 10 /),'u200') /)
    246 
    247   type(ctrl_out),dimension(4) :: o_vSTDlevs     = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'v850'), &
     251                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'u200'), &
     252                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'u50'), &
     253                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'u10') /)
     254                                                     
     255
     256  type(ctrl_out),save,dimension(6) :: o_vSTDlevs     = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'v850'), &
    248257                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'v700'), &
    249258                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'v500'), &
    250                                                      ctrl_out((/ 1, 1, 3, 10, 10 /),'v200') /)
    251 
    252   type(ctrl_out),dimension(4) :: o_wSTDlevs     = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'w850'), &
     259                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'v200'), &
     260                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'v50'), &
     261                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'v10') /)
     262
     263  type(ctrl_out),save,dimension(6) :: o_wSTDlevs     = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'w850'), &
    253264                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'w700'), &
    254265                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'w500'), &
    255                                                      ctrl_out((/ 1, 1, 3, 10, 10 /),'w200') /)
    256 
    257   type(ctrl_out),dimension(4) :: o_tSTDlevs     = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'t850'), &
     266                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'w200'), &
     267                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'w50'), &
     268                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'w10') /)
     269
     270  type(ctrl_out),save,dimension(6) :: o_tSTDlevs     = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'t850'), &
    258271                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'t700'), &
    259272                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'t500'), &
    260                                                      ctrl_out((/ 1, 1, 3, 10, 10 /),'t200') /)
    261 
    262   type(ctrl_out),dimension(4) :: o_qSTDlevs     = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'q850'), &
     273                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'t200'), &
     274                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'t50'), &
     275                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'t10') /)
     276
     277  type(ctrl_out),save,dimension(6) :: o_qSTDlevs     = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'q850'), &
    263278                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'q700'), &
    264279                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'q500'), &
    265                                                      ctrl_out((/ 1, 1, 3, 10, 10 /),'q200') /)
    266 
    267   type(ctrl_out),dimension(4) :: o_phiSTDlevs   = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'phi850'), &
     280                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'q200'), &
     281                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'q50'), &
     282                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'q10') /)
     283
     284  type(ctrl_out),save,dimension(6) :: o_phiSTDlevs   = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'phi850'), &
    268285                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'phi700'), &
    269286                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'phi500'), &
    270                                                      ctrl_out((/ 1, 1, 3, 10, 10 /),'phi200') /)
    271 
    272 
    273   type(ctrl_out) :: o_t_oce_sic    = ctrl_out((/ 1, 10, 10, 10, 10 /),'t_oce_sic')
    274 
    275   type(ctrl_out) :: o_weakinv      = ctrl_out((/ 10, 1, 10, 10, 10 /),'weakinv')
    276   type(ctrl_out) :: o_dthmin       = ctrl_out((/ 10, 1, 10, 10, 10 /),'dthmin')
    277   type(ctrl_out),dimension(4) :: o_u10_srf      = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'u10_ter'), &
     287                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'phi200'), &
     288                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'phi50'), &
     289                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'phi10') /)
     290
     291
     292  type(ctrl_out),save :: o_t_oce_sic    = ctrl_out((/ 1, 10, 10, 10, 10 /),'t_oce_sic')
     293
     294  type(ctrl_out),save :: o_weakinv      = ctrl_out((/ 10, 1, 10, 10, 10 /),'weakinv')
     295  type(ctrl_out),save :: o_dthmin       = ctrl_out((/ 10, 1, 10, 10, 10 /),'dthmin')
     296  type(ctrl_out),save,dimension(4) :: o_u10_srf      = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'u10_ter'), &
    278297                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'u10_lic'), &
    279298                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'u10_oce'), &
    280299                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'u10_sic') /)
    281300
    282   type(ctrl_out),dimension(4) :: o_v10_srf      = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'v10_ter'), &
     301  type(ctrl_out),save,dimension(4) :: o_v10_srf      = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'v10_ter'), &
    283302                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'v10_lic'), &
    284303                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'v10_oce'), &
    285304                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'v10_sic') /)
    286305
    287   type(ctrl_out) :: o_cldtau       = ctrl_out((/ 10, 5, 10, 10, 10 /),'cldtau')                     
    288   type(ctrl_out) :: o_cldemi       = ctrl_out((/ 10, 5, 10, 10, 10 /),'cldemi')
    289   type(ctrl_out) :: o_rh2m         = ctrl_out((/ 10, 5, 10, 10, 10 /),'rh2m')
    290   type(ctrl_out) :: o_qsat2m       = ctrl_out((/ 10, 5, 10, 10, 10 /),'qsat2m')
    291   type(ctrl_out) :: o_tpot         = ctrl_out((/ 10, 5, 10, 10, 10 /),'tpot')
    292   type(ctrl_out) :: o_tpote        = ctrl_out((/ 10, 5, 10, 10, 10 /),'tpote')
    293   type(ctrl_out) :: o_tke          = ctrl_out((/ 4, 10, 10, 10, 10 /),'tke ')
    294   type(ctrl_out) :: o_tke_max      = ctrl_out((/ 4, 10, 10, 10, 10 /),'tke_max')
    295 
    296   type(ctrl_out),dimension(4) :: o_tke_srf      = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_ter'), &
     306  type(ctrl_out),save :: o_cldtau       = ctrl_out((/ 10, 5, 10, 10, 10 /),'cldtau')                     
     307  type(ctrl_out),save :: o_cldemi       = ctrl_out((/ 10, 5, 10, 10, 10 /),'cldemi')
     308  type(ctrl_out),save :: o_rh2m         = ctrl_out((/ 10, 5, 10, 10, 10 /),'rh2m')
     309  type(ctrl_out),save :: o_qsat2m       = ctrl_out((/ 10, 5, 10, 10, 10 /),'qsat2m')
     310  type(ctrl_out),save :: o_tpot         = ctrl_out((/ 10, 5, 10, 10, 10 /),'tpot')
     311  type(ctrl_out),save :: o_tpote        = ctrl_out((/ 10, 5, 10, 10, 10 /),'tpote')
     312  type(ctrl_out),save :: o_tke          = ctrl_out((/ 4, 10, 10, 10, 10 /),'tke ')
     313  type(ctrl_out),save :: o_tke_max      = ctrl_out((/ 4, 10, 10, 10, 10 /),'tke_max')
     314
     315  type(ctrl_out),save,dimension(4) :: o_tke_srf      = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_ter'), &
    297316                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_lic'), &
    298317                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_oce'), &
    299318                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_sic') /)
    300319
    301   type(ctrl_out),dimension(4) :: o_tke_max_srf  = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_max_ter'), &
     320  type(ctrl_out),save,dimension(4) :: o_tke_max_srf  = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_max_ter'), &
    302321                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_max_lic'), &
    303322                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_max_oce'), &
    304323                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_max_sic') /)
    305324
    306   type(ctrl_out) :: o_kz           = ctrl_out((/ 4, 10, 10, 10, 10 /),'kz')
    307   type(ctrl_out) :: o_kz_max       = ctrl_out((/ 4, 10, 10, 10, 10 /),'kz_max')
    308   type(ctrl_out) :: o_SWnetOR      = ctrl_out((/ 10, 10, 2, 10, 10 /),'SWnetOR')
    309   type(ctrl_out) :: o_SWdownOR     = ctrl_out((/ 10, 10, 2, 10, 10 /),'SWdownOR')
    310   type(ctrl_out) :: o_LWdownOR     = ctrl_out((/ 10, 10, 2, 10, 10 /),'LWdownOR')
    311 
    312   type(ctrl_out) :: o_snowl        = ctrl_out((/ 10, 1, 10, 10, 10 /),'snowl')
    313   type(ctrl_out) :: o_cape_max     = ctrl_out((/ 10, 1, 10, 10, 10 /),'cape_max')
    314   type(ctrl_out) :: o_solldown     = ctrl_out((/ 10, 1, 10, 1, 10 /),'solldown')
    315 
    316   type(ctrl_out) :: o_dtsvdfo      = ctrl_out((/ 10, 10, 10, 1, 10 /),'dtsvdfo')
    317   type(ctrl_out) :: o_dtsvdft      = ctrl_out((/ 10, 10, 10, 1, 10 /),'dtsvdft')
    318   type(ctrl_out) :: o_dtsvdfg      = ctrl_out((/ 10, 10, 10, 1, 10 /),'dtsvdfg')
    319   type(ctrl_out) :: o_dtsvdfi      = ctrl_out((/ 10, 10, 10, 1, 10 /),'dtsvdfi')
    320   type(ctrl_out) :: o_rugs         = ctrl_out((/ 10, 10, 10, 1, 1 /),'rugs')
    321 
    322   type(ctrl_out) :: o_topswad      = ctrl_out((/ 4, 10, 10, 10, 10 /),'topswad')
    323   type(ctrl_out) :: o_topswai      = ctrl_out((/ 4, 10, 10, 10, 10 /),'topswai')
    324   type(ctrl_out) :: o_solswad      = ctrl_out((/ 4, 10, 10, 10, 10 /),'solswad')
    325   type(ctrl_out) :: o_solswai      = ctrl_out((/ 4, 10, 10, 10, 10 /),'solswai')
     325  type(ctrl_out),save :: o_kz           = ctrl_out((/ 4, 10, 10, 10, 10 /),'kz')
     326  type(ctrl_out),save :: o_kz_max       = ctrl_out((/ 4, 10, 10, 10, 10 /),'kz_max')
     327  type(ctrl_out),save :: o_SWnetOR      = ctrl_out((/ 10, 10, 2, 10, 10 /),'SWnetOR')
     328  type(ctrl_out),save :: o_SWdownOR     = ctrl_out((/ 10, 10, 2, 10, 10 /),'SWdownOR')
     329  type(ctrl_out),save :: o_LWdownOR     = ctrl_out((/ 10, 10, 2, 10, 10 /),'LWdownOR')
     330
     331  type(ctrl_out),save :: o_snowl        = ctrl_out((/ 10, 1, 10, 10, 10 /),'snowl')
     332  type(ctrl_out),save :: o_cape_max     = ctrl_out((/ 10, 1, 10, 10, 10 /),'cape_max')
     333  type(ctrl_out),save :: o_solldown     = ctrl_out((/ 10, 1, 10, 1, 10 /),'solldown')
     334
     335  type(ctrl_out),save :: o_dtsvdfo      = ctrl_out((/ 10, 10, 10, 1, 10 /),'dtsvdfo')
     336  type(ctrl_out),save :: o_dtsvdft      = ctrl_out((/ 10, 10, 10, 1, 10 /),'dtsvdft')
     337  type(ctrl_out),save :: o_dtsvdfg      = ctrl_out((/ 10, 10, 10, 1, 10 /),'dtsvdfg')
     338  type(ctrl_out),save :: o_dtsvdfi      = ctrl_out((/ 10, 10, 10, 1, 10 /),'dtsvdfi')
     339  type(ctrl_out),save :: o_rugs         = ctrl_out((/ 10, 10, 10, 1, 1 /),'rugs')
     340
     341  type(ctrl_out),save :: o_topswad      = ctrl_out((/ 4, 10, 10, 10, 10 /),'topswad')
     342  type(ctrl_out),save :: o_topswai      = ctrl_out((/ 4, 10, 10, 10, 10 /),'topswai')
     343  type(ctrl_out),save :: o_solswad      = ctrl_out((/ 4, 10, 10, 10, 10 /),'solswad')
     344  type(ctrl_out),save :: o_solswai      = ctrl_out((/ 4, 10, 10, 10, 10 /),'solswai')
     345
     346  type(ctrl_out),save,dimension(10) :: o_tausumaero  = (/ ctrl_out((/ 4, 10, 10, 10, 10 /),'OD550_ASBCM'), &
     347                                                     ctrl_out((/ 4, 10, 10, 10, 10 /),'OD550_ASPOMM'), &
     348                                                     ctrl_out((/ 4, 10, 10, 10, 10 /),'OD550_ASSO4M'), &
     349                                                     ctrl_out((/ 4, 10, 10, 10, 10 /),'OD550_CSSO4M'), &
     350                                                     ctrl_out((/ 4, 10, 10, 10, 10 /),'OD550_SSSSM'), &
     351                                                     ctrl_out((/ 4, 10, 10, 10, 10 /),'OD550_ASSSM'), &
     352                                                     ctrl_out((/ 4, 10, 10, 10, 10 /),'OD550_CSSSM'), &
     353                                                     ctrl_out((/ 4, 10, 10, 10, 10 /),'OD550_CIDUSTM'), &
     354                                                     ctrl_out((/ 4, 10, 10, 10, 10 /),'OD550_AIBCM'), &
     355                                                     ctrl_out((/ 4, 10, 10, 10, 10 /),'OD550_AIPOMM') /)
     356
     357  type(ctrl_out),save :: o_swtoaas_nat      = ctrl_out((/ 4, 10, 10, 10, 10 /),'swtoaas_nat')
     358  type(ctrl_out),save :: o_swsrfas_nat      = ctrl_out((/ 4, 10, 10, 10, 10 /),'swsrfas_nat')
     359  type(ctrl_out),save :: o_swtoacs_nat      = ctrl_out((/ 4, 10, 10, 10, 10 /),'swtoacs_nat')
     360  type(ctrl_out),save :: o_swsrfcs_nat      = ctrl_out((/ 4, 10, 10, 10, 10 /),'swsrfcs_nat')
     361
     362  type(ctrl_out),save :: o_swtoaas_ant      = ctrl_out((/ 4, 10, 10, 10, 10 /),'swtoaas_ant')
     363  type(ctrl_out),save :: o_swsrfas_ant      = ctrl_out((/ 4, 10, 10, 10, 10 /),'swsrfas_ant')
     364  type(ctrl_out),save :: o_swtoacs_ant      = ctrl_out((/ 4, 10, 10, 10, 10 /),'swtoacs_ant')
     365  type(ctrl_out),save :: o_swsrfcs_ant      = ctrl_out((/ 4, 10, 10, 10, 10 /),'swsrfcs_ant')
     366
     367  type(ctrl_out),save :: o_swtoacf_nat      = ctrl_out((/ 4, 10, 10, 10, 10 /),'swtoacf_nat')
     368  type(ctrl_out),save :: o_swsrfcf_nat      = ctrl_out((/ 4, 10, 10, 10, 10 /),'swsrfcf_nat')
     369  type(ctrl_out),save :: o_swtoacf_ant      = ctrl_out((/ 4, 10, 10, 10, 10 /),'swtoacf_ant')
     370  type(ctrl_out),save :: o_swsrfcf_ant      = ctrl_out((/ 4, 10, 10, 10, 10 /),'swsrfcf_ant')
     371  type(ctrl_out),save :: o_swtoacf_zero      = ctrl_out((/ 4, 10, 10, 10, 10 /),'swtoacf_zero')
     372  type(ctrl_out),save :: o_swsrfcf_zero      = ctrl_out((/ 4, 10, 10, 10, 10 /),'swsrfcf_zero')
     373
     374
    326375!!!!!!!!!!!!!!!!!!!!!! 3D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    327   type(ctrl_out) :: o_lwcon        = ctrl_out((/ 2, 5, 10, 10, 1 /),'lwcon')
    328   type(ctrl_out) :: o_iwcon        = ctrl_out((/ 2, 5, 10, 10, 10 /),'iwcon')
    329   type(ctrl_out) :: o_temp         = ctrl_out((/ 2, 3, 4, 1, 1 /),'temp')
    330   type(ctrl_out) :: o_theta        = ctrl_out((/ 2, 3, 4, 1, 1 /),'theta')
    331   type(ctrl_out) :: o_ovap         = ctrl_out((/ 2, 3, 4, 1, 1 /),'ovap')
    332   type(ctrl_out) :: o_ovapinit         = ctrl_out((/ 2, 3, 4, 1, 1 /),'ovapinit')
    333   type(ctrl_out) :: o_wvapp        = ctrl_out((/ 2, 10, 10, 10, 10 /),'wvapp')
    334   type(ctrl_out) :: o_geop         = ctrl_out((/ 2, 3, 10, 1, 1 /),'geop')
    335   type(ctrl_out) :: o_vitu         = ctrl_out((/ 2, 3, 4, 1, 1 /),'vitu')
    336   type(ctrl_out) :: o_vitv         = ctrl_out((/ 2, 3, 4, 1, 1 /),'vitv')
    337   type(ctrl_out) :: o_vitw         = ctrl_out((/ 2, 3, 10, 10, 1 /),'vitw')
    338   type(ctrl_out) :: o_pres         = ctrl_out((/ 2, 3, 10, 1, 1 /),'pres')
    339   type(ctrl_out) :: o_rneb         = ctrl_out((/ 2, 5, 10, 10, 1 /),'rneb')
    340   type(ctrl_out) :: o_rnebcon      = ctrl_out((/ 2, 5, 10, 10, 1 /),'rnebcon')
    341   type(ctrl_out) :: o_rhum         = ctrl_out((/ 2, 10, 10, 10, 10 /),'rhum')
    342   type(ctrl_out) :: o_ozone        = ctrl_out((/ 2, 10, 10, 10, 10 /),'ozone')
    343   type(ctrl_out) :: o_upwd         = ctrl_out((/ 2, 10, 10, 10, 10 /),'upwd')
    344   type(ctrl_out) :: o_dtphy        = ctrl_out((/ 2, 10, 10, 10, 1 /),'dtphy')
    345   type(ctrl_out) :: o_dqphy        = ctrl_out((/ 2, 10, 10, 10, 1 /),'dqphy')
    346   type(ctrl_out) :: o_pr_con_l     = ctrl_out((/ 2, 10, 10, 10, 10 /),'pr_con_l')
    347   type(ctrl_out) :: o_pr_con_i     = ctrl_out((/ 2, 10, 10, 10, 10 /),'pr_con_i')
    348   type(ctrl_out) :: o_pr_lsc_l     = ctrl_out((/ 2, 10, 10, 10, 10 /),'pr_lsc_l')
    349   type(ctrl_out) :: o_pr_lsc_i     = ctrl_out((/ 2, 10, 10, 10, 10 /),'pr_lsc_i')
     376  type(ctrl_out),save :: o_lwcon        = ctrl_out((/ 2, 5, 10, 10, 1 /),'lwcon')
     377  type(ctrl_out),save :: o_iwcon        = ctrl_out((/ 2, 5, 10, 10, 10 /),'iwcon')
     378  type(ctrl_out),save :: o_temp         = ctrl_out((/ 2, 3, 4, 1, 1 /),'temp')
     379  type(ctrl_out),save :: o_theta        = ctrl_out((/ 2, 3, 4, 1, 1 /),'theta')
     380  type(ctrl_out),save :: o_ovap         = ctrl_out((/ 2, 3, 4, 1, 1 /),'ovap')
     381  type(ctrl_out),save :: o_ovapinit         = ctrl_out((/ 2, 3, 4, 1, 1 /),'ovapinit')
     382  type(ctrl_out),save :: o_wvapp        = ctrl_out((/ 2, 10, 10, 10, 10 /),'wvapp')
     383  type(ctrl_out),save :: o_geop         = ctrl_out((/ 2, 3, 10, 1, 1 /),'geop')
     384  type(ctrl_out),save :: o_vitu         = ctrl_out((/ 2, 3, 4, 1, 1 /),'vitu')
     385  type(ctrl_out),save :: o_vitv         = ctrl_out((/ 2, 3, 4, 1, 1 /),'vitv')
     386  type(ctrl_out),save :: o_vitw         = ctrl_out((/ 2, 3, 10, 10, 1 /),'vitw')
     387  type(ctrl_out),save :: o_pres         = ctrl_out((/ 2, 3, 10, 1, 1 /),'pres')
     388  type(ctrl_out),save :: o_rneb         = ctrl_out((/ 2, 5, 10, 10, 1 /),'rneb')
     389  type(ctrl_out),save :: o_rnebcon      = ctrl_out((/ 2, 5, 10, 10, 1 /),'rnebcon')
     390  type(ctrl_out),save :: o_rhum         = ctrl_out((/ 2, 10, 10, 10, 10 /),'rhum')
     391  type(ctrl_out),save :: o_ozone        = ctrl_out((/ 2, 10, 10, 10, 10 /),'ozone')
     392  type(ctrl_out),save :: o_ozone_light        = ctrl_out((/ 2, 10, 10, 10, 10 /),'ozone_daylight')
     393  type(ctrl_out),save :: o_upwd         = ctrl_out((/ 2, 10, 10, 10, 10 /),'upwd')
     394  type(ctrl_out),save :: o_dtphy        = ctrl_out((/ 2, 10, 10, 10, 1 /),'dtphy')
     395  type(ctrl_out),save :: o_dqphy        = ctrl_out((/ 2, 10, 10, 10, 1 /),'dqphy')
     396  type(ctrl_out),save :: o_pr_con_l     = ctrl_out((/ 2, 10, 10, 10, 10 /),'pr_con_l')
     397  type(ctrl_out),save :: o_pr_con_i     = ctrl_out((/ 2, 10, 10, 10, 10 /),'pr_con_i')
     398  type(ctrl_out),save :: o_pr_lsc_l     = ctrl_out((/ 2, 10, 10, 10, 10 /),'pr_lsc_l')
     399  type(ctrl_out),save :: o_pr_lsc_i     = ctrl_out((/ 2, 10, 10, 10, 10 /),'pr_lsc_i')
    350400!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    351401
    352   type(ctrl_out),dimension(4) :: o_albe_srf     = (/ ctrl_out((/ 3, 4, 10, 1, 10 /),'albe_ter'), &
     402  type(ctrl_out),save,dimension(4) :: o_albe_srf     = (/ ctrl_out((/ 3, 4, 10, 1, 10 /),'albe_ter'), &
    353403                                                     ctrl_out((/ 3, 4, 10, 1, 10 /),'albe_lic'), &
    354404                                                     ctrl_out((/ 3, 4, 10, 1, 10 /),'albe_oce'), &
    355405                                                     ctrl_out((/ 3, 4, 10, 1, 10 /),'albe_sic') /)
    356406
    357   type(ctrl_out),dimension(4) :: o_ages_srf     = (/ ctrl_out((/ 3, 10, 10, 10, 10 /),'ages_ter'), &
     407  type(ctrl_out),save,dimension(4) :: o_ages_srf     = (/ ctrl_out((/ 3, 10, 10, 10, 10 /),'ages_ter'), &
    358408                                                     ctrl_out((/ 3, 10, 10, 10, 10 /),'ages_lic'), &
    359409                                                     ctrl_out((/ 3, 10, 10, 10, 10 /),'ages_oce'), &
    360410                                                     ctrl_out((/ 3, 10, 10, 10, 10 /),'ages_sic') /)
    361411
    362   type(ctrl_out),dimension(4) :: o_rugs_srf     = (/ ctrl_out((/ 3, 4, 10, 1, 10 /),'rugs_ter'), &
     412  type(ctrl_out),save,dimension(4) :: o_rugs_srf     = (/ ctrl_out((/ 3, 4, 10, 1, 10 /),'rugs_ter'), &
    363413                                                     ctrl_out((/ 3, 4, 10, 1, 10 /),'rugs_lic'), &
    364414                                                     ctrl_out((/ 3, 4, 10, 1, 10 /),'rugs_oce'), &
    365415                                                     ctrl_out((/ 3, 4, 10, 1, 10 /),'rugs_sic') /)
    366416
    367   type(ctrl_out) :: o_albs         = ctrl_out((/ 3, 10, 10, 1, 10 /),'albs')
    368   type(ctrl_out) :: o_albslw       = ctrl_out((/ 3, 10, 10, 1, 10 /),'albslw')
    369 
    370   type(ctrl_out) :: o_clwcon       = ctrl_out((/ 4, 10, 10, 10, 10 /),'clwcon')
    371   type(ctrl_out) :: o_Ma           = ctrl_out((/ 4, 10, 10, 10, 10 /),'Ma')
    372   type(ctrl_out) :: o_dnwd         = ctrl_out((/ 4, 10, 10, 10, 10 /),'dnwd')
    373   type(ctrl_out) :: o_dnwd0        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dnwd0')
    374   type(ctrl_out) :: o_dtdyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dtdyn')
    375   type(ctrl_out) :: o_dqdyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dqdyn')
    376   type(ctrl_out) :: o_dudyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dudyn')  !AXC
    377   type(ctrl_out) :: o_dvdyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dvdyn')  !AXC
    378   type(ctrl_out) :: o_dtcon        = ctrl_out((/ 4, 5, 10, 10, 10 /),'dtcon')
    379   type(ctrl_out) :: o_ducon        = ctrl_out((/ 4, 10, 10, 10, 10 /),'ducon')
    380   type(ctrl_out) :: o_dqcon        = ctrl_out((/ 4, 5, 10, 10, 10 /),'dqcon')
    381   type(ctrl_out) :: o_dtwak        = ctrl_out((/ 4, 5, 10, 10, 10 /),'dtwak')
    382   type(ctrl_out) :: o_dqwak        = ctrl_out((/ 4, 5, 10, 10, 10 /),'dqwak')
    383   type(ctrl_out) :: o_wake_h       = ctrl_out((/ 4, 5, 10, 10, 10 /),'wake_h')
    384   type(ctrl_out) :: o_wake_s       = ctrl_out((/ 4, 5, 10, 10, 10 /),'wake_s')
    385   type(ctrl_out) :: o_wake_deltat  = ctrl_out((/ 4, 5, 10, 10, 10 /),'wake_deltat')
    386   type(ctrl_out) :: o_wake_deltaq  = ctrl_out((/ 4, 5, 10, 10, 10 /),'wake_deltaq')
    387   type(ctrl_out) :: o_wake_omg     = ctrl_out((/ 4, 5, 10, 10, 10 /),'wake_omg')
    388   type(ctrl_out) :: o_Vprecip      = ctrl_out((/ 10, 10, 10, 10, 10 /),'Vprecip')
    389   type(ctrl_out) :: o_ftd          = ctrl_out((/ 4, 5, 10, 10, 10 /),'ftd')
    390   type(ctrl_out) :: o_fqd          = ctrl_out((/ 4, 5, 10, 10, 10 /),'fqd')
    391   type(ctrl_out) :: o_dtlsc        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtlsc')
    392   type(ctrl_out) :: o_dtlschr      = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtlschr')
    393   type(ctrl_out) :: o_dqlsc        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dqlsc')
    394   type(ctrl_out) :: o_dtvdf        = ctrl_out((/ 4, 10, 10, 1, 10 /),'dtvdf')
    395   type(ctrl_out) :: o_dqvdf        = ctrl_out((/ 4, 10, 10, 1, 10 /),'dqvdf')
    396   type(ctrl_out) :: o_dteva        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dteva')
    397   type(ctrl_out) :: o_dqeva        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dqeva')
    398   type(ctrl_out) :: o_ptconv       = ctrl_out((/ 4, 10, 10, 10, 10 /),'ptconv')
    399   type(ctrl_out) :: o_ratqs        = ctrl_out((/ 4, 10, 10, 10, 10 /),'ratqs')
    400   type(ctrl_out) :: o_dtthe        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtthe')
    401   type(ctrl_out) :: o_f_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'f_th')
    402   type(ctrl_out) :: o_e_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'e_th')
    403   type(ctrl_out) :: o_w_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'w_th')
    404   type(ctrl_out) :: o_lambda_th    = ctrl_out((/ 4, 10, 10, 10, 10 /),'lambda_th')
    405   type(ctrl_out) :: o_q_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'q_th')
    406   type(ctrl_out) :: o_a_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'a_th')
    407   type(ctrl_out) :: o_d_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'d_th')
    408   type(ctrl_out) :: o_f0_th        = ctrl_out((/ 4, 10, 10, 10, 10 /),'f0_th')
    409   type(ctrl_out) :: o_zmax_th      = ctrl_out((/ 4, 10, 10, 10, 10 /),'zmax_th')
    410   type(ctrl_out) :: o_dqthe        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dqthe')
    411   type(ctrl_out) :: o_dtajs        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtajs')
    412   type(ctrl_out) :: o_dqajs        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dqajs')
    413   type(ctrl_out) :: o_dtswr        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dtswr')
    414   type(ctrl_out) :: o_dtsw0        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtsw0')
    415   type(ctrl_out) :: o_dtlwr        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dtlwr')
    416   type(ctrl_out) :: o_dtlw0        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtlw0')
    417   type(ctrl_out) :: o_dtec         = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtec')
    418   type(ctrl_out) :: o_duvdf        = ctrl_out((/ 4, 10, 10, 10, 10 /),'duvdf')
    419   type(ctrl_out) :: o_dvvdf        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dvvdf')
    420   type(ctrl_out) :: o_duoro        = ctrl_out((/ 4, 10, 10, 10, 10 /),'duoro')
    421   type(ctrl_out) :: o_dvoro        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dvoro')
    422   type(ctrl_out) :: o_dulif        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dulif')
    423   type(ctrl_out) :: o_dvlif        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dvlif')
     417  type(ctrl_out),save :: o_albs         = ctrl_out((/ 3, 10, 10, 1, 10 /),'albs')
     418  type(ctrl_out),save :: o_albslw       = ctrl_out((/ 3, 10, 10, 1, 10 /),'albslw')
     419
     420  type(ctrl_out),save :: o_clwcon       = ctrl_out((/ 4, 10, 10, 10, 10 /),'clwcon')
     421  type(ctrl_out),save :: o_Ma           = ctrl_out((/ 4, 10, 10, 10, 10 /),'Ma')
     422  type(ctrl_out),save :: o_dnwd         = ctrl_out((/ 4, 10, 10, 10, 10 /),'dnwd')
     423  type(ctrl_out),save :: o_dnwd0        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dnwd0')
     424  type(ctrl_out),save :: o_dtdyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dtdyn')
     425  type(ctrl_out),save :: o_dqdyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dqdyn')
     426  type(ctrl_out),save :: o_dudyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dudyn')  !AXC
     427  type(ctrl_out),save :: o_dvdyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dvdyn')  !AXC
     428  type(ctrl_out),save :: o_dtcon        = ctrl_out((/ 4, 5, 10, 10, 10 /),'dtcon')
     429  type(ctrl_out),save :: o_ducon        = ctrl_out((/ 4, 10, 10, 10, 10 /),'ducon')
     430  type(ctrl_out),save :: o_dqcon        = ctrl_out((/ 4, 5, 10, 10, 10 /),'dqcon')
     431  type(ctrl_out),save :: o_dtwak        = ctrl_out((/ 4, 5, 10, 10, 10 /),'dtwak')
     432  type(ctrl_out),save :: o_dqwak        = ctrl_out((/ 4, 5, 10, 10, 10 /),'dqwak')
     433  type(ctrl_out),save :: o_wake_h       = ctrl_out((/ 4, 5, 10, 10, 10 /),'wake_h')
     434  type(ctrl_out),save :: o_wake_s       = ctrl_out((/ 4, 5, 10, 10, 10 /),'wake_s')
     435  type(ctrl_out),save :: o_wake_deltat  = ctrl_out((/ 4, 5, 10, 10, 10 /),'wake_deltat')
     436  type(ctrl_out),save :: o_wake_deltaq  = ctrl_out((/ 4, 5, 10, 10, 10 /),'wake_deltaq')
     437  type(ctrl_out),save :: o_wake_omg     = ctrl_out((/ 4, 5, 10, 10, 10 /),'wake_omg')
     438  type(ctrl_out),save :: o_Vprecip      = ctrl_out((/ 10, 10, 10, 10, 10 /),'Vprecip')
     439  type(ctrl_out),save :: o_ftd          = ctrl_out((/ 4, 5, 10, 10, 10 /),'ftd')
     440  type(ctrl_out),save :: o_fqd          = ctrl_out((/ 4, 5, 10, 10, 10 /),'fqd')
     441  type(ctrl_out),save :: o_dtlsc        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtlsc')
     442  type(ctrl_out),save :: o_dtlschr      = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtlschr')
     443  type(ctrl_out),save :: o_dqlsc        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dqlsc')
     444  type(ctrl_out),save :: o_dtvdf        = ctrl_out((/ 4, 10, 10, 1, 10 /),'dtvdf')
     445  type(ctrl_out),save :: o_dqvdf        = ctrl_out((/ 4, 10, 10, 1, 10 /),'dqvdf')
     446  type(ctrl_out),save :: o_dteva        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dteva')
     447  type(ctrl_out),save :: o_dqeva        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dqeva')
     448  type(ctrl_out),save :: o_ptconv       = ctrl_out((/ 4, 10, 10, 10, 10 /),'ptconv')
     449  type(ctrl_out),save :: o_ratqs        = ctrl_out((/ 4, 10, 10, 10, 10 /),'ratqs')
     450  type(ctrl_out),save :: o_dtthe        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtthe')
     451  type(ctrl_out),save :: o_f_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'f_th')
     452  type(ctrl_out),save :: o_e_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'e_th')
     453  type(ctrl_out),save :: o_w_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'w_th')
     454  type(ctrl_out),save :: o_lambda_th    = ctrl_out((/ 10, 10, 10, 10, 10 /),'lambda_th')
     455  type(ctrl_out),save :: o_q_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'q_th')
     456  type(ctrl_out),save :: o_a_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'a_th')
     457  type(ctrl_out),save :: o_d_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'d_th')
     458  type(ctrl_out),save :: o_f0_th        = ctrl_out((/ 4, 10, 10, 10, 10 /),'f0_th')
     459  type(ctrl_out),save :: o_zmax_th      = ctrl_out((/ 4, 10, 10, 10, 10 /),'zmax_th')
     460  type(ctrl_out),save :: o_dqthe        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dqthe')
     461  type(ctrl_out),save :: o_dtajs        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtajs')
     462  type(ctrl_out),save :: o_dqajs        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dqajs')
     463  type(ctrl_out),save :: o_dtswr        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dtswr')
     464  type(ctrl_out),save :: o_dtsw0        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtsw0')
     465  type(ctrl_out),save :: o_dtlwr        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dtlwr')
     466  type(ctrl_out),save :: o_dtlw0        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtlw0')
     467  type(ctrl_out),save :: o_dtec         = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtec')
     468  type(ctrl_out),save :: o_duvdf        = ctrl_out((/ 4, 10, 10, 10, 10 /),'duvdf')
     469  type(ctrl_out),save :: o_dvvdf        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dvvdf')
     470  type(ctrl_out),save :: o_duoro        = ctrl_out((/ 4, 10, 10, 10, 10 /),'duoro')
     471  type(ctrl_out),save :: o_dvoro        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dvoro')
     472  type(ctrl_out),save :: o_dulif        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dulif')
     473  type(ctrl_out),save :: o_dvlif        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dvlif')
    424474
    425475! Attention a refaire correctement
    426   type(ctrl_out),dimension(2) :: o_trac         = (/ ctrl_out((/ 4, 10, 10, 10, 10 /),'trac01'), &
     476  type(ctrl_out),save,dimension(2) :: o_trac         = (/ ctrl_out((/ 4, 10, 10, 10, 10 /),'trac01'), &
    427477                                                     ctrl_out((/ 4, 10, 10, 10, 10 /),'trac02') /)
    428478    CONTAINS
    … …  
    434484 
    435485  SUBROUTINE phys_output_open(jjmp1,nlevSTD,clevSTD,nbteta, &
    436                               ctetaSTD,dtime, presnivs, ok_veget, &
    437                               type_ocean, iflag_pbl,ok_mensuel,ok_journe, &
    438                               ok_hf,ok_instan,ok_LES,ok_ade,ok_aie)   
     486       ctetaSTD,dtime, ok_veget, &
     487       type_ocean, iflag_pbl,ok_mensuel,ok_journe, &
     488       ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, read_climoz, &
     489       new_aod, aerosol_couple)   
     490
    439491
    440492  USE iophy
    … …  
    443495  USE ioipsl
    444496  USE mod_phys_lmdz_para
     497  USE aero_mod, only : naero_spc,name_aero
    445498
    446499  IMPLICIT NONE
    … …  
    450503  include "clesphys.h"
    451504  include "thermcell.h"
     505  include "comvert.h"
    452506
    453507  integer                               :: jjmp1
    … …  
    455509  logical                               :: ok_mensuel, ok_journe, ok_hf, ok_instan
    456510  logical                               :: ok_LES,ok_ade,ok_aie
     511  logical                               :: new_aod, aerosol_couple
     512  integer, intent(in)::  read_climoz ! read ozone climatology
     513  !     Allowed values are 0, 1 and 2
     514  !     0: do not read an ozone climatology
     515  !     1: read a single ozone climatology that will be used day and night
     516  !     2: read two ozone climatologies, the average day and night
     517  !     climatology and the daylight climatology
     518
    457519  real                                  :: dtime
    458520  integer                               :: idayref
    459521  real                                  :: zjulian
    460   real, dimension(klev)                 :: presnivs
     522  real, dimension(klev)                 :: Ahyb, Bhyb, Alt
    461523  character(len=4), dimension(nlevSTD)  :: clevSTD
    462524  integer                               :: nsrf, k, iq, iiq, iff, i, j, ilev
     525  integer                               :: naero
    463526  logical                               :: ok_veget
    464527  integer                               :: iflag_pbl
    … …  
    468531  CHARACTER(len=3)                      :: ctetaSTD(nbteta)
    469532  real, dimension(nfiles)               :: ecrit_files
    470   CHARACTER(len=20), dimension(nfiles)  :: name_files
     533  CHARACTER(len=20), dimension(nfiles)  :: phys_out_filenames
    471534  INTEGER, dimension(iim*jjmp1)         ::  ndex2d
    472535  INTEGER, dimension(iim*jjmp1*klev)    :: ndex3d
    473536  integer                               :: imin_ins, imax_ins
    474537  integer                               :: jmin_ins, jmax_ins
     538  integer, dimension(nfiles)            :: phys_out_levmin, phys_out_levmax
     539  integer, dimension(nfiles)            :: phys_out_filelevels
     540  CHARACTER(len=20), dimension(nfiles)  :: type_ecri_files, phys_out_filetypes
     541  character(len=20), dimension(nfiles)  :: chtimestep   = (/ 'DefFreq', 'DefFreq','DefFreq', 'DefFreq', 'DefFreq' /)
     542  logical, dimension(nfiles)            :: phys_out_filekeys
    475543
    476544!!!!!!!!!! stockage dans une region limitee pour chaque fichier !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    477 !                 entre [lonmin_reg,lonmax_reg] et [latmin_reg,latmax_reg]
    478 
    479   logical, dimension(nfiles), save  :: ok_reglim         = (/ .false., .false., .false., .false., .true. /)
    480   real, dimension(nfiles), save     :: lonmin_reg        = (/ 0., -45., 0., 0., -162. /)
    481   real, dimension(nfiles), save     :: lonmax_reg        = (/ 90., 45., 90., 90., -144. /)
    482   real, dimension(nfiles), save     :: latmin_reg        = (/ 0., -45., 0., 0., 7. /)
    483   real, dimension(nfiles), save     :: latmax_reg        = (/ 90., 90., 90., 90., 21. /)
    484 
    485    levmax = (/ klev, klev, klev, klev, 17 /)
    486 
    487    name_files(1) = 'histmth'
    488    name_files(2) = 'histday'
    489    name_files(3) = 'histhf'
    490    name_files(4) = 'histins'
    491    name_files(5) = 'histLES'
     545!                 entre [phys_out_lonmin,phys_out_lonmax] et [phys_out_latmin,phys_out_latmax]
     546
     547  logical, dimension(nfiles), save  :: phys_out_regfkey       = (/ .false., .false., .false., .false., .false. /)
     548  real, dimension(nfiles), save     :: phys_out_lonmin        = (/ -180., -180., -180., -180., -180. /)
     549  real, dimension(nfiles), save     :: phys_out_lonmax        = (/ 180., 180., 180., 180., 180. /)
     550  real, dimension(nfiles), save     :: phys_out_latmin        = (/ -90., -90., -90., -90., -90. /)
     551  real, dimension(nfiles), save     :: phys_out_latmax        = (/ 90., 90., 90., 90., 90. /)
     552 
     553 
     554
     555!
     556   print*,'Debut phys_output_mod.F90'
     557! Initialisations (Valeurs par defaut
     558   levmax = (/ klev, klev, klev, klev, klev /)
     559
     560   phys_out_filenames(1) = 'histmth'
     561   phys_out_filenames(2) = 'histday'
     562   phys_out_filenames(3) = 'histhf'
     563   phys_out_filenames(4) = 'histins'
     564   phys_out_filenames(5) = 'histLES'
    492565
    493566   type_ecri(1) = 'ave(X)'
    … …  
    495568   type_ecri(3) = 'ave(X)'
    496569   type_ecri(4) = 'inst(X)'
    497    type_ecri(5) = 'ave(X)'
     570   type_ecri(5) = 'inst(X)'
    498571
    499572   clef_files(1) = ok_mensuel
    … …  
    506579   lev_files(2) = lev_histday
    507580   lev_files(3) = lev_histhf
    508    lev_files(4) = 1
    509    lev_files(5) = 1
     581   lev_files(4) = lev_histins
     582   lev_files(5) = lev_histLES
     583
    510584
    511585   ecrit_files(1) = ecrit_mth
    … …  
    515589   ecrit_files(5) = ecrit_LES
    516590 
     591!! Lectures des parametres de sorties dans physiq.def
     592
     593   call getin('phys_out_regfkey',phys_out_regfkey)
     594   call getin('phys_out_lonmin',phys_out_lonmin)
     595   call getin('phys_out_lonmax',phys_out_lonmax)
     596   call getin('phys_out_latmin',phys_out_latmin)
     597   call getin('phys_out_latmax',phys_out_latmax)
     598     phys_out_levmin(:)=levmin(:)
     599   call getin('phys_out_levmin',levmin)
     600     phys_out_levmax(:)=levmax(:)
     601   call getin('phys_out_levmax',levmax)
     602   call getin('phys_out_filenames',phys_out_filenames)
     603     phys_out_filekeys(:)=clef_files(:)
     604   call getin('phys_out_filekeys',clef_files)
     605     phys_out_filelevels(:)=lev_files(:)
     606   call getin('phys_out_filelevels',lev_files)
     607   call getin('phys_out_filetimesteps',chtimestep)
     608     phys_out_filetypes(:)=type_ecri(:)
     609   call getin('phys_out_filetypes',type_ecri)
     610
     611   type_ecri_files(:)=type_ecri(:)
     612
     613   print*,'phys_out_lonmin=',phys_out_lonmin
     614   print*,'phys_out_lonmax=',phys_out_lonmax
     615   print*,'phys_out_latmin=',phys_out_latmin
     616   print*,'phys_out_latmax=',phys_out_latmax
     617   print*,'phys_out_filenames=',phys_out_filenames
     618   print*,'phys_out_filetypes=',type_ecri
     619   print*,'phys_out_filekeys=',clef_files
     620   print*,'phys_out_filelevels=',lev_files
     621
    517622!!!!!!!!!!!!!!!!!!!!!!! Boucle sur les fichiers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    518623! Appel de histbeg et histvert pour creer le fichier et les niveaux verticaux !!
    … …  
    520625!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    521626
     627 zdtime = dtime         ! Frequence ou l on moyenne
     628
     629! Calcul des Ahyb, Bhyb et Alt
     630         do k=1,klev
     631          Ahyb(k)=(ap(k)+ap(k+1))/2.
     632          Bhyb(k)=(bp(k)+bp(k+1))/2.
     633          Alt(k)=log(preff/presnivs(k))*8.
     634         enddo
     635!          if(prt_level.ge.1) then
     636           print*,'Ap Hybrid = ',Ahyb(1:klev)
     637           print*,'Bp Hybrid = ',Bhyb(1:klev)
     638           print*,'Alt approx des couches pour une haut d echelle de 8km = ',Alt(1:klev)
     639!          endif
    522640 DO iff=1,nfiles
    523641
    524642    IF (clef_files(iff)) THEN
    525      
    526       zstophym(iff) = dtime         ! Frequence ou l on moyenne
    527       zoutm(iff) = ecrit_files(iff) ! Frequence ou l on ecrit
     643
     644      if ( chtimestep(iff).eq.'DefFreq' ) then
     645! Par defaut ecrit_files = (ecrit_mensuel ecrit_jour ecrit_hf ...)*86400.
     646        ecrit_files(iff)=ecrit_files(iff)*86400.
     647      else
     648        call convers_timesteps(chtimestep(iff),ecrit_files(iff))
     649      endif
     650       print*,'ecrit_files(',iff,')= ',ecrit_files(iff)
     651
     652      zoutm(iff) = ecrit_files(iff) ! Frequence ou l on ecrit en seconde
    528653
    529654      idayref = day_ref
    … …  
    532657!!!!!!!!!!!!!!!!! Traitement dans le cas ou l'on veut stocker sur un domaine limite !!
    533658!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    534      if (ok_reglim(iff)) then
     659     if (phys_out_regfkey(iff)) then
    535660
    536661        imin_ins=1
    … …  
    539664        jmax_ins=jjmp1
    540665
    541 ! correction abderr        do i=1,iim-1
     666! correction abderr       
    542667        do i=1,iim
    543668           print*,'io_lon(i)=',io_lon(i)
    544            if (io_lon(i).le.lonmin_reg(iff)) imin_ins=i
    545            if (io_lon(i).le.lonmax_reg(iff)) imax_ins=i
     669           if (io_lon(i).le.phys_out_lonmin(iff)) imin_ins=i
     670           if (io_lon(i).le.phys_out_lonmax(iff)) imax_ins=i+1
    546671        enddo
    547672
    548         do j=1,jjmp1-1
     673        do j=1,jjmp1
    549674            print*,'io_lat(j)=',io_lat(j)
    550             if (io_lat(j).ge.latmin_reg(iff)) jmax_ins=j+1
    551             if (io_lat(j).ge.latmax_reg(iff)) jmin_ins=j
     675            if (io_lat(j).ge.phys_out_latmin(iff)) jmax_ins=j+1
     676            if (io_lat(j).ge.phys_out_latmax(iff)) jmin_ins=j
    552677        enddo
    553678
    554          print*,'On stoke le fichier hist sur, ', &
     679        print*,'On stoke le fichier histoire numero ',iff,' sur ', &
    555680         imin_ins,imax_ins,jmin_ins,jmax_ins
    556          print*,'On stoke le fichier instantanne sur, ', &
     681         print*,'longitudes : ', &
    557682         io_lon(imin_ins),io_lon(imax_ins), &
    558          io_lat(jmin_ins),io_lat(jmax_ins)
    559 
    560  CALL histbeg(name_files(iff),iim,io_lon,jjmp1,io_lat, &
     683         'latitudes : ', &
     684         io_lat(jmax_ins),io_lat(jmin_ins)
     685
     686 CALL histbeg(phys_out_filenames(iff),iim,io_lon,jjmp1,io_lat, &
    561687              imin_ins,imax_ins-imin_ins+1, &
    562688              jmin_ins,jmax_ins-jmin_ins+1, &
    … …  
    564690!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    565691       else
    566  CALL histbeg_phy(name_files(iff),itau_phy,zjulian,dtime,nhorim(iff),nid_files(iff))
     692 CALL histbeg_phy(phys_out_filenames(iff),itau_phy,zjulian,dtime,nhorim(iff),nid_files(iff))
    567693       endif
    568694 
    … …  
    582708!     &                 klev, presnivs/100., nvertm)
    583709!          ENDIF
    584 
     710!
     711!!!! Composentes de la coordonnee sigma-hybride
     712   CALL histvert(nid_files(iff), "Ahyb","Ahyb comp of Hyb Cord ", "Pa", &
     713                 levmax(iff) - levmin(iff) + 1,Ahyb,nvertap(iff))
     714
     715   CALL histvert(nid_files(iff), "Bhyb","Bhyb comp of Hyb Cord", " ", &
     716                 levmax(iff) - levmin(iff) + 1,Bhyb,nvertbp(iff))
     717
     718   CALL histvert(nid_files(iff), "Alt","Height approx for scale heigh of 8km at levels", "Km", &
     719                 levmax(iff) - levmin(iff) + 1,Alt,nvertAlt(iff))
     720
     721!   CALL histvert(nid_files(iff), "preff","Reference pressure", "Pa", &
     722!                 1,preff,nvertp0(iff))
    585723!!! Champs 1D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    586724 CALL histdef2d(iff,o_phis%flag,o_phis%name,"Surface geop.height", "m2/s2")
    … …  
    592730 CALL histdef2d(iff,o_aire%flag,o_aire%name,"Grid area", "-")
    593731 CALL histdef2d(iff,o_contfracATM%flag,o_contfracATM%name,"% sfce ter+lic", "-")
    594    type_ecri(1) = 'ave(X)'
    595    type_ecri(2) = 'ave(X)'
    596    type_ecri(3) = 'ave(X)'
    597    type_ecri(4) = 'inst(X)'
    598    type_ecri(5) = 'ave(X)'
     732   type_ecri(:) = type_ecri_files(:)
    599733
    600734!!! Champs 2D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    617751   type_ecri(5) = 't_max(X)'
    618752 CALL histdef2d(iff,o_t2m_max%flag,o_t2m_max%name, "Temp 2m max", "K" )
    619    type_ecri(1) = 'ave(X)'
    620    type_ecri(2) = 'ave(X)'
    621    type_ecri(3) = 'ave(X)'
    622    type_ecri(4) = 'inst(X)'
    623    type_ecri(5) = 'ave(X)'
     753   type_ecri(:) = type_ecri_files(:)
    624754 CALL histdef2d(iff,o_wind10m%flag,o_wind10m%name, "10-m wind speed", "m/s")
    625755 CALL histdef2d(iff,o_wind10max%flag,o_wind10max%name, "10m wind speed max", "m/s")
    … …  
    700830   type_ecri(5) = 't_max(X)'
    701831 CALL histdef2d(iff,o_tke_max_srf(nsrf)%flag,o_tke_max_srf(nsrf)%name,"Max Turb. Kinetic Energy "//clnsurf(nsrf),"-")
    702    type_ecri(1) = 'ave(X)'
    703    type_ecri(2) = 'ave(X)'
    704    type_ecri(3) = 'ave(X)'
    705    type_ecri(4) = 'inst(X)'
    706    type_ecri(5) = 'ave(X)'
     832   type_ecri(:) = type_ecri_files(:)
    707833  endif
    708834 CALL histdef2d(iff,o_albe_srf(nsrf)%flag,o_albe_srf(nsrf)%name,"Albedo surf. "//clnsurf(nsrf),"-")
    709835 CALL histdef2d(iff,o_rugs_srf(nsrf)%flag,o_rugs_srf(nsrf)%name,"Latent heat flux "//clnsurf(nsrf),"W/m2")
    710836 CALL histdef2d(iff,o_ages_srf(nsrf)%flag,o_ages_srf(nsrf)%name,"Snow age", "day")
    711      END DO
     837END DO
     838
     839IF (new_aod .AND. (.NOT. aerosol_couple)) THEN
     840  DO naero = 1, naero_spc
     841  CALL histdef2d(iff,o_tausumaero(naero)%flag,o_tausumaero(naero)%name,"Aerosol Optical depth at 550 nm "//name_aero(naero),"1")
     842  END DO
     843ENDIF
    712844
    713845 IF (ok_ade) THEN
    714846  CALL histdef2d(iff,o_topswad%flag,o_topswad%name, "ADE at TOA", "W/m2")
    715847  CALL histdef2d(iff,o_solswad%flag,o_solswad%name, "ADE at SRF", "W/m2")
     848
     849 CALL histdef2d(iff,o_swtoaas_nat%flag,o_swtoaas_nat%name, "Natural aerosol radiative forcing all-sky at TOA", "W/m2")
     850 CALL histdef2d(iff,o_swsrfas_nat%flag,o_swsrfas_nat%name, "Natural aerosol radiative forcing all-sky at SRF", "W/m2")
     851 CALL histdef2d(iff,o_swtoacs_nat%flag,o_swtoacs_nat%name, "Natural aerosol radiative forcing clear-sky at TOA", "W/m2")
     852 CALL histdef2d(iff,o_swsrfcs_nat%flag,o_swsrfcs_nat%name, "Natural aerosol radiative forcing clear-sky at SRF", "W/m2")
     853
     854 CALL histdef2d(iff,o_swtoaas_ant%flag,o_swtoaas_ant%name, "Anthropogenic aerosol radiative forcing all-sky at TOA", "W/m2")
     855 CALL histdef2d(iff,o_swsrfas_ant%flag,o_swsrfas_ant%name, "Anthropogenic aerosol radiative forcing all-sky at SRF", "W/m2")
     856 CALL histdef2d(iff,o_swtoacs_ant%flag,o_swtoacs_ant%name, "Anthropogenic aerosol radiative forcing clear-sky at TOA", "W/m2")
     857 CALL histdef2d(iff,o_swsrfcs_ant%flag,o_swsrfcs_ant%name, "Anthropogenic aerosol radiative forcing clear-sky at SRF", "W/m2")
     858
     859 IF (.NOT. aerosol_couple) THEN
     860 CALL histdef2d(iff,o_swtoacf_nat%flag,o_swtoacf_nat%name, "Natural aerosol impact on cloud radiative forcing at TOA", "W/m2")
     861 CALL histdef2d(iff,o_swsrfcf_nat%flag,o_swsrfcf_nat%name, "Natural aerosol impact on cloud radiative forcing  at SRF", "W/m2")
     862 CALL histdef2d(iff,o_swtoacf_ant%flag,o_swtoacf_ant%name, "Anthropogenic aerosol impact on cloud radiative forcing at TOA", "W/m2")
     863 CALL histdef2d(iff,o_swsrfcf_ant%flag,o_swsrfcf_ant%name, "Anthropogenic aerosol impact on cloud radiative forcing at SRF", "W/m2")
     864 CALL histdef2d(iff,o_swtoacf_zero%flag,o_swtoacf_zero%name, "Cloud radiative forcing (allsky-clearsky fluxes) at TOA", "W/m2")
     865 CALL histdef2d(iff,o_swsrfcf_zero%flag,o_swsrfcf_zero%name, "Cloud radiative forcing (allsky-clearsky fluxes) at SRF", "W/m2")
     866 ENDIF
     867
    716868 ENDIF
    717869
    … …  
    750902   type_ecri(5) = 't_max(X)'
    751903 CALL histdef2d(iff,o_cape_max%flag,o_cape_max%name, "CAPE max.", "J/kg")
    752    type_ecri(1) = 'ave(X)'
    753    type_ecri(2) = 'ave(X)'
    754    type_ecri(3) = 'ave(X)'
    755    type_ecri(4) = 'inst(X)'
    756    type_ecri(5) = 'ave(X)'
     904   type_ecri(:) = type_ecri_files(:)
    757905 CALL histdef3d(iff,o_upwd%flag,o_upwd%name, "saturated updraft", "kg/m2/s")
    758906 CALL histdef3d(iff,o_Ma%flag,o_Ma%name, "undilute adiab updraft", "kg/m2/s")
    … …  
    773921
    774922! Champs interpolles sur des niveaux de pression
    775 ! iif=1 on ecrit u v w phi sur 850 700 500 200 au niv 1
    776 ! iif=2 on ecrit w et ph 500 seulement au niv 1
    777 !        et u v sur 850 700 500 200
    778 ! iif=3 on ecrit ph a 500 seulement au niv 1
    779 !      on ecrit u v t q a 850 700 500 200 au niv 3
    780 
    781    zstophym(iff) = ecrit_files(iff)
     923
    782924   type_ecri(1) = 'inst(X)'
    783925   type_ecri(2) = 'inst(X)'
    … …  
    790932        ilev=0       
    791933        DO k=1, nlevSTD
    792      IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
    793 !     IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
    794      IF(bb2.EQ."850".OR.bb2.EQ."700".OR.bb2.EQ."500".OR.bb2.EQ."200")THEN
     934!     IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
     935     bb2=clevSTD(k)
     936     IF(bb2.EQ."850".OR.bb2.EQ."700".OR.bb2.EQ."500".OR.bb2.EQ."200".OR.bb2.EQ."50".OR.bb2.EQ."10")THEN
    795937      ilev=ilev+1
    796       print*,'ilev bb2 flag name ',ilev,bb2,o_uSTDlevs(ilev)%flag,o_uSTDlevs(ilev)%name
     938      print*,'ilev k bb2 flag name ',ilev,k, bb2,o_uSTDlevs(ilev)%flag,o_uSTDlevs(ilev)%name
    797939 CALL histdef2d(iff,o_uSTDlevs(ilev)%flag,o_uSTDlevs(ilev)%name,"Zonal wind "//bb2//"mb", "m/s")
    798940 CALL histdef2d(iff,o_vSTDlevs(ilev)%flag,o_vSTDlevs(ilev)%name,"Meridional wind "//bb2//"mb", "m/s")
    … …  
    801943 CALL histdef2d(iff,o_qSTDlevs(ilev)%flag,o_qSTDlevs(ilev)%name,"Specific humidity "//bb2//"mb", "kg/kg" )
    802944 CALL histdef2d(iff,o_tSTDlevs(ilev)%flag,o_tSTDlevs(ilev)%name,"Temperature "//bb2//"mb", "K")
    803      ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR."500".OR.bb2.EQ."200")
     945     ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR."500".OR.bb2.EQ."200".OR.bb2.EQ."50".OR.bb2.EQ."10")
    804946       ENDDO
    805    zstophym(iff) = dtime
    806    type_ecri(1) = 'ave(X)'
    807    type_ecri(2) = 'ave(X)'
    808    type_ecri(3) = 'ave(X)'
    809    type_ecri(4) = 'inst(X)'
    810    type_ecri(5) = 'ave(X)'
     947   type_ecri(:) = type_ecri_files(:)
    811948
    812949 CALL histdef2d(iff,o_t_oce_sic%flag,o_t_oce_sic%name, "Temp mixte oce-sic", "K")
    … …  
    822959    ENDIF
    823960 ENDIF !(iflag_con.GE.3)
    824 
    825961
    826962 CALL histdef2d(iff,o_weakinv%flag,o_weakinv%name, "Weak inversion", "-")
    … …  
    834970 CALL histdef2d(iff,o_LWdownOR%flag,o_LWdownOR%name, "Sfce incident LW radiation OR", "W/m2")
    835971 CALL histdef2d(iff,o_snowl%flag,o_snowl%name, "Solid Large-scale Precip.", "kg/(m2*s)")
     972
    836973 CALL histdef2d(iff,o_solldown%flag,o_solldown%name, "Down. IR rad. at surface", "W/m2")
    837974 CALL histdef2d(iff,o_dtsvdfo%flag,o_dtsvdfo%name, "Boundary-layer dTs(o)", "K/s")
    … …  
    856993 CALL histdef3d(iff,o_rnebcon%flag,o_rnebcon%name, "Convective Cloud Fraction", "-")
    857994 CALL histdef3d(iff,o_rhum%flag,o_rhum%name, "Relative humidity", "-")
    858  CALL histdef3d(iff,o_ozone%flag,o_ozone%name, "Ozone concentration", "ppmv")
     995 CALL histdef3d(iff,o_ozone%flag,o_ozone%name, "Ozone mole fraction", "-")
     996 if (read_climoz == 2) &
     997      CALL histdef3d(iff,o_ozone_light%flag,o_ozone_light%name, &
     998      "Daylight ozone mole fraction", "-")
    859999 CALL histdef3d(iff,o_dtphy%flag,o_dtphy%name, "Physics dT", "K/s")
    8601000 CALL histdef3d(iff,o_dqphy%flag,o_dqphy%name, "Physics dQ", "(kg/kg)/s")
    … …  
    8621002 CALL histdef3d(iff,o_cldemi%flag,o_cldemi%name, "Cloud optical emissivity", "1")
    8631003!IM: bug ?? dimensionnement variables (klon,klev+1) pmflxr, pmflxs, prfl, psfl
    864 ! CALL histdef3d(iff,o_pr_con_l%flag,o_pmflxr%name, "Convective precipitation lic", " ")
    865 ! CALL histdef3d(iff,o_pr_con_i%flag,o_pmflxs%name, "Convective precipitation ice", " ")
    866 ! CALL histdef3d(iff,o_pr_lsc_l%flag,o_prfl%name, "Large scale precipitation lic", " ")
    867 ! CALL histdef3d(iff,o_pr_lsc_i%flag,o_psfl%name, "Large scale precipitation ice", " ")
    868 
     1004 CALL histdef3d(iff,o_pr_con_l%flag,o_pr_con_l%name, "Convective precipitation lic", " ")
     1005 CALL histdef3d(iff,o_pr_con_i%flag,o_pr_con_i%name, "Convective precipitation ice", " ")
     1006 CALL histdef3d(iff,o_pr_lsc_l%flag,o_pr_lsc_l%name, "Large scale precipitation lic", " ")
     1007 CALL histdef3d(iff,o_pr_lsc_i%flag,o_pr_lsc_i%name, "Large scale precipitation ice", " ")
    8691008!FH Sorties pour la couche limite
    8701009     if (iflag_pbl>1) then
    … …  
    8761015   type_ecri(5) = 't_max(X)'
    8771016 CALL histdef3d(iff,o_tke_max%flag,o_tke_max%name, "TKE max", "m2/s2")
    878    type_ecri(1) = 'ave(X)'
    879    type_ecri(2) = 'ave(X)'
    880    type_ecri(3) = 'ave(X)'
    881    type_ecri(4) = 'inst(X)'
    882    type_ecri(5) = 'ave(X)'
     1017   type_ecri(:) = type_ecri_files(:)
    8831018     endif
    8841019
    … …  
    8901025   type_ecri(5) = 't_max(X)'
    8911026 CALL histdef3d(iff,o_kz_max%flag,o_kz_max%name, "Kz melange max", "m2/s" )
    892    type_ecri(1) = 'ave(X)'
    893    type_ecri(2) = 'ave(X)'
    894    type_ecri(3) = 'ave(X)'
    895    type_ecri(4) = 'inst(X)'
    896    type_ecri(5) = 'ave(X)'
     1027   type_ecri(:) = type_ecri_files(:)
    8971028 CALL histdef3d(iff,o_clwcon%flag,o_clwcon%name, "Convective Cloud Liquid water content", "kg/kg")
    8981029 CALL histdef3d(iff,o_dtdyn%flag,o_dtdyn%name, "Dynamics dT", "K/s")
    … …  
    9851116         ENDIF ! clef_files
    9861117
    987          ENDDO !
     1118         ENDDO !  iff
     1119     print*,'Fin phys_output_mod.F90'
    9881120      end subroutine phys_output_open
    9891121
    … …  
    10071139       character(len=*)                 :: unitvar
    10081140
     1141       real zstophym
     1142
     1143       if (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') then
     1144         zstophym=zoutm(iff)
     1145       else
     1146         zstophym=zdtime
     1147       endif
     1148
    10091149! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
    10101150       call conf_physoutputs(nomvar,flag_var)
    … …  
    10131153 call histdef (nid_files(iff),nomvar,titrevar,unitvar, &
    10141154               iim,jj_nb,nhorim(iff), 1,1,1, -99, 32, &
    1015                type_ecri(iff), zstophym(iff),zoutm(iff))               
     1155               type_ecri(iff), zstophym,zoutm(iff))               
    10161156       endif                     
    10171157      end subroutine histdef2d
    … …  
    10361176       character(len=*)                 :: unitvar
    10371177
     1178       real zstophym
     1179
    10381180! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
    10391181       call conf_physoutputs(nomvar,flag_var)
     1182
     1183       if (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') then
     1184         zstophym=zoutm(iff)
     1185       else
     1186         zstophym=zdtime
     1187       endif
    10401188
    10411189       if ( flag_var(iff)<=lev_files(iff) ) then
    … …  
    10431191               iim, jj_nb, nhorim(iff), klev, levmin(iff), &
    10441192               levmax(iff)-levmin(iff)+1, nvertm(iff), 32, type_ecri(iff), &
    1045                zstophym(iff), zoutm(iff))
     1193               zstophym, zoutm(iff))
    10461194       endif
    10471195      end subroutine histdef3d
    … …  
    10581206       character(len=20)                :: nam_var
    10591207       integer, dimension(nfiles)      :: flag_var
    1060        integer, dimension(nfiles),save :: flag_var_omp
    1061        character(len=20),save           :: nam_var_omp
    1062 
    1063         flag_var_omp = flag_var
    1064         nam_var_omp = nam_var
     1208
    10651209        IF(prt_level>10) WRITE(lunout,*)'Avant getin: nam_var flag_var ',nam_var,flag_var(:)
    1066         call getin('flag_'//nam_var,flag_var_omp)
    1067         flag_var = flag_var_omp
    1068         call getin('name_'//nam_var,nam_var_omp)
    1069         nam_var=nam_var_omp
    1070        
     1210        call getin('flag_'//nam_var,flag_var)
     1211        call getin('name_'//nam_var,nam_var)
    10711212        IF(prt_level>10) WRITE(lunout,*)'Apres getin: nam_var flag_var ',nam_var,flag_var(:)
    10721213
    10731214      END SUBROUTINE conf_physoutputs
    10741215
     1216      SUBROUTINE convers_timesteps(str,timestep)
     1217
     1218        use ioipsl
     1219
     1220        IMPLICIT NONE
     1221
     1222        character(len=20)   :: str
     1223        character(len=10)   :: type
     1224        integer             :: ipos,il
     1225        real                :: ttt,xxx,timestep,dayseconde
     1226        parameter (dayseconde=86400.)
     1227        include "temps.h"
     1228        include "comconst.h"
     1229
     1230        ipos=scan(str,'0123456789.',.true.)
     1231! 
     1232        il=len_trim(str)
     1233        print*,ipos,il
     1234        read(str(1:ipos),*) ttt
     1235        print*,ttt
     1236        type=str(ipos+1:il)
     1237
     1238
     1239        if ( il == ipos ) then
     1240        type='day'
     1241        endif
     1242
     1243        if ( type == 'day'.or.type == 'days'.or.type == 'jours'.or.type == 'jour' ) timestep = ttt * dayseconde
     1244        if ( type == 'mounths'.or.type == 'mth'.or.type == 'mois' ) then
     1245           print*,'annee_ref,day_ref mon_len',annee_ref,day_ref,ioget_mon_len(annee_ref,day_ref)
     1246           timestep = ttt * dayseconde * ioget_mon_len(annee_ref,day_ref)
     1247        endif
     1248        if ( type == 'hours'.or.type == 'hr'.or.type == 'heurs') timestep = ttt * dayseconde / 24.
     1249        if ( type == 'mn'.or.type == 'minutes'  ) timestep = ttt * 60.
     1250        if ( type == 's'.or.type == 'sec'.or.type == 'secondes'   ) timestep = ttt
     1251        if ( type == 'TS' ) timestep = dtphys
     1252
     1253        print*,'type =      ',type
     1254        print*,'nb j/h/m =  ',ttt
     1255        print*,'timestep(s)=',timestep
     1256
     1257        END SUBROUTINE convers_timesteps
     1258
    10751259END MODULE phys_output_mod
    10761260

  • LMDZ4/trunk/libf/phylmd/phys_output_write.h

    r1146 r1279  
    219219       IF (o_LWdn200%flag(iff)<=lev_files(iff)) THEN
    220220      CALL histwrite_phy(nid_files(iff),
    221      s                   o_LWdn200%name,itau_w,zx_tmp_fi2d)
     221     s                   o_LWdn200%name,itau_w,LWdn200)
    222222       ENDIF
    223223
    224224       IF (o_LWdn200clr%flag(iff)<=lev_files(iff)) THEN
    225225      CALL histwrite_phy(nid_files(iff),
    226      s                  o_LWdn200clr%name,itau_w,zx_tmp_fi2d)
     226     s                  o_LWdn200clr%name,itau_w,LWdn200clr)
    227227       ENDIF
    228228
    … …  
    575575
    576576! Champs interpolles sur des niveaux de pression
    577 ! if=1 on ecrit u v w phi sur 850 700 500 200 au niv 1
    578 ! if=2 on ecrit w et ph 500 seulement au niv 1
    579 !        et u v sur 850 700 500 200
    580 ! if=3 on ecrit ph a 500 seulement au niv 1
    581 !      on ecrit u v t q a 850 700 500 200 au niv 3
    582577
    583578        ll=0
    584579        DO k=1, nlevSTD
    585          IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
    586          IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
     580!         IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
     581!         IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
     582         bb2=clevSTD(k)
    587583         IF(bb2.EQ."850".OR.bb2.EQ."700".OR.
    588      $      bb2.EQ."500".OR.bb2.EQ."200") THEN
     584     $      bb2.EQ."500".OR.bb2.EQ."200".OR.
     585     $      bb2.EQ."50".OR.bb2.EQ."10") THEN
    589586
    590587! a refaire correctement !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    746743       ENDIF
    747744
    748 !      IF (o_pr_con_l%flag(iff)<=lev_files(iff)) THEN
    749 !      CALL histwrite_phy(nid_files(iff),o_pmflxr%name,itau_w,pmflxr)
    750 !      ENDIF
    751 
    752 !      IF (o_pr_con_i%flag(iff)<=lev_files(iff)) THEN
    753 !      CALL histwrite_phy(nid_files(iff),o_pmflxs%name,itau_w,pmflxs)
    754 !      ENDIF
    755 
    756 !      IF (o_pr_lsc_l%flag(iff)<=lev_files(iff)) THEN
    757 !      CALL histwrite_phy(nid_files(iff),o_prfl%name,itau_w,prfl)
    758 !      ENDIF
    759 
    760 !      IF (o_pr_lsc_i%flag(iff)<=lev_files(iff)) THEN
    761 !      CALL histwrite_phy(nid_files(iff),o_psfl%name,itau_w,psfl)
    762 !      ENDIF
     745      IF (o_pr_con_l%flag(iff)<=lev_files(iff)) THEN
     746      CALL histwrite_phy(nid_files(iff),
     747     s         o_pr_con_l%name,itau_w,pmflxr(:,1:klev))
     748      ENDIF
     749
     750      IF (o_pr_con_i%flag(iff)<=lev_files(iff)) THEN
     751      CALL histwrite_phy(nid_files(iff),
     752     s         o_pr_con_i%name,itau_w,pmflxs(:,1:klev))
     753      ENDIF
     754
     755      IF (o_pr_lsc_l%flag(iff)<=lev_files(iff)) THEN
     756      CALL histwrite_phy(nid_files(iff),
     757     s        o_pr_lsc_l%name,itau_w,prfl(:,1:klev))
     758      ENDIF
     759
     760      IF (o_pr_lsc_i%flag(iff)<=lev_files(iff)) THEN
     761      CALL histwrite_phy(nid_files(iff),
     762     s        o_pr_lsc_i%name,itau_w,psfl(:,1:klev))
     763      ENDIF
     764
    763765
    764766      IF (o_rh2m%flag(iff)<=lev_files(iff)) THEN
    … …  
    831833       ENDIF
    832834
     835! OD550 per species
     836      IF (new_aod .and. (.not. aerosol_couple)) THEN
     837      DO naero = 1, naero_spc
     838          IF (o_tausumaero(naero)%flag(iff)<=lev_files(iff)) THEN
     839             CALL histwrite_phy(nid_files(iff),
     840     $            o_tausumaero(naero)%name,itau_w,
     841     $            tausum_aero(:,2,naero) )
     842          ENDIF
     843      END DO
     844      ENDIF
     845
    833846       IF (ok_ade) THEN
    834         IF (o_topswad%flag(iff)<=lev_files(iff)) THEN
    835       CALL histwrite_phy(nid_files(iff),o_topswad%name,itau_w,topswad)
    836         ENDIF
    837         IF (o_solswad%flag(iff)<=lev_files(iff)) THEN
    838       CALL histwrite_phy(nid_files(iff),o_solswad%name,itau_w,solswad)
    839         ENDIF
     847          IF (o_topswad%flag(iff)<=lev_files(iff)) THEN
     848             CALL histwrite_phy(nid_files(iff),o_topswad%name,itau_w,
     849     $            topswad_aero)
     850          ENDIF
     851          IF (o_solswad%flag(iff)<=lev_files(iff)) THEN
     852             CALL histwrite_phy(nid_files(iff),o_solswad%name,itau_w,
     853     $            solswad_aero)
     854          ENDIF
     855
     856!====MS forcing diagnostics
     857        if (new_aod) then             
     858        IF (o_swtoaas_nat%flag(iff)<=lev_files(iff)) THEN
     859        CALL histwrite_phy(nid_files(iff),o_swtoaas_nat%name,itau_w,
     860     $      topsw_aero(:,1))
     861        ENDIF
     862
     863        IF (o_swsrfas_nat%flag(iff)<=lev_files(iff)) THEN
     864        CALL histwrite_phy(nid_files(iff),o_swsrfas_nat%name,itau_w,
     865     $      solsw_aero(:,1))
     866        ENDIF
     867
     868        IF (o_swtoacs_nat%flag(iff)<=lev_files(iff)) THEN
     869        CALL histwrite_phy(nid_files(iff),o_swtoacs_nat%name,itau_w,
     870     $      topsw0_aero(:,1))
     871        ENDIF
     872
     873        IF (o_swsrfcs_nat%flag(iff)<=lev_files(iff)) THEN
     874        CALL histwrite_phy(nid_files(iff),o_swsrfcs_nat%name,itau_w,
     875     $      solsw0_aero(:,1))
     876        ENDIF
     877 
     878!ant
     879        IF (o_swtoaas_ant%flag(iff)<=lev_files(iff)) THEN
     880        CALL histwrite_phy(nid_files(iff),o_swtoaas_ant%name,itau_w,
     881     $      topsw_aero(:,2))
     882        ENDIF
     883
     884        IF (o_swsrfas_ant%flag(iff)<=lev_files(iff)) THEN
     885        CALL histwrite_phy(nid_files(iff),o_swsrfas_ant%name,itau_w,
     886     $      solsw_aero(:,2))
     887        ENDIF
     888
     889        IF (o_swtoacs_ant%flag(iff)<=lev_files(iff)) THEN
     890        CALL histwrite_phy(nid_files(iff),o_swtoacs_ant%name,itau_w,
     891     $      topsw0_aero(:,2))
     892        ENDIF
     893
     894        IF (o_swsrfcs_ant%flag(iff)<=lev_files(iff)) THEN
     895        CALL histwrite_phy(nid_files(iff),o_swsrfcs_ant%name,itau_w,
     896     $      solsw0_aero(:,2))
     897        ENDIF
     898
     899!cf
     900
     901        if (.not. aerosol_couple) then
     902        IF (o_swtoacf_nat%flag(iff)<=lev_files(iff)) THEN
     903        CALL histwrite_phy(nid_files(iff),o_swtoacf_nat%name,itau_w,
     904     $      topswcf_aero(:,1))
     905        ENDIF
     906
     907        IF (o_swsrfcf_nat%flag(iff)<=lev_files(iff)) THEN
     908        CALL histwrite_phy(nid_files(iff),o_swsrfcf_nat%name,itau_w,
     909     $      solswcf_aero(:,1))
     910        ENDIF
     911
     912        IF (o_swtoacf_ant%flag(iff)<=lev_files(iff)) THEN
     913        CALL histwrite_phy(nid_files(iff),o_swtoacf_ant%name,itau_w,
     914     $      topswcf_aero(:,2))
     915        ENDIF
     916
     917        IF (o_swsrfcf_ant%flag(iff)<=lev_files(iff)) THEN
     918        CALL histwrite_phy(nid_files(iff),o_swsrfcf_ant%name,itau_w,
     919     $      solswcf_aero(:,2))
     920        ENDIF
     921
     922        IF (o_swtoacf_zero%flag(iff)<=lev_files(iff)) THEN
     923        CALL histwrite_phy(nid_files(iff),o_swtoacf_zero%name,itau_w,
     924     $      topswcf_aero(:,3))
     925        ENDIF
     926
     927        IF (o_swsrfcf_zero%flag(iff)<=lev_files(iff)) THEN
     928        CALL histwrite_phy(nid_files(iff),o_swsrfcf_zero%name,itau_w,
     929     $      solswcf_aero(:,3))
     930        ENDIF
     931        endif
     932
     933        endif ! new_aod
     934!====MS forcing diagnostics
     935
    840936       ENDIF
    841937
    842938       IF (ok_aie) THEN
    843         IF (o_topswai%flag(iff)<=lev_files(iff)) THEN
    844       CALL histwrite_phy(nid_files(iff),o_topswai%name,itau_w,topswai)
    845         ENDIF
    846         IF (o_solswai%flag(iff)<=lev_files(iff)) THEN
    847       CALL histwrite_phy(nid_files(iff),o_solswai%name,itau_w,solswai)
    848         ENDIF
     939          IF (o_topswai%flag(iff)<=lev_files(iff)) THEN
     940             CALL histwrite_phy(nid_files(iff),o_topswai%name,itau_w,
     941     $            topswai_aero)
     942          ENDIF
     943          IF (o_solswai%flag(iff)<=lev_files(iff)) THEN
     944             CALL histwrite_phy(nid_files(iff),o_solswai%name,itau_w,
     945     $            solswai_aero)
     946          ENDIF
    849947       ENDIF
    850948
    … …  
    9081006
    9091007      IF (o_ozone%flag(iff)<=lev_files(iff)) THEN
    910       DO k=1, klev
    911        DO i=1, klon
    912          zx_tmp_fi3d(i,k)=wo(i,k)*RG/46.6968
    913      $                    /(paprs(i,k)-paprs(i,k+1))
    914      $                    *(paprs(i,1)/101325.0)
    915        ENDDO !i
    916       ENDDO !k
    917       CALL histwrite_phy(nid_files(iff),o_ozone%name,itau_w,zx_tmp_fi3d)
     1008         CALL histwrite_phy(nid_files(iff), o_ozone%name, itau_w,
     1009     $        wo(:, :, 1) * dobson_u * 1e3 / zmasse / rmo3 * rmd)
     1010      ENDIF
     1011
     1012      IF (o_ozone_light%flag(iff)<=lev_files(iff) .and.
     1013     $     read_climoz == 2) THEN
     1014         CALL histwrite_phy(nid_files(iff), o_ozone_light%name, itau_w,
     1015     $        wo(:, :, 2) * dobson_u * 1e3 / zmasse / rmo3 * rmd)
    9181016      ENDIF
    9191017

  • LMDZ4/trunk/libf/phylmd/phys_state_var_mod.F90

    r1054 r1279  
    1111      INTEGER, PARAMETER :: napisccp=1
    1212      INTEGER, SAVE :: radpas
    13       REAL, SAVE :: dtime, co2_ppm_etat0, solaire_etat0
     13      REAL, SAVE :: dtime, solaire_etat0
    1414!$OMP THREADPRIVATE(radpas)
    15 !$OMP THREADPRIVATE(dtime, co2_ppm_etat0, solaire_etat0)
     15!$OMP THREADPRIVATE(dtime, solaire_etat0)
    1616
    1717      REAL, ALLOCATABLE, SAVE :: rlat(:), rlon(:), pctsrf(:,:)
    … …  
    202202      REAL,ALLOCATABLE,SAVE :: albsol1(:), albsol2(:)
    203203!$OMP THREADPRIVATE(albsol1,albsol2)
    204       REAL,ALLOCATABLE,SAVE :: wo(:,:)
    205 !$OMP THREADPRIVATE(wo)
    206 !
     204
     205      REAL, ALLOCATABLE, SAVE:: wo(:, :, :)
     206      ! column-density of ozone in a layer, in kilo-Dobsons
     207      ! Third dimension has size 1 or 2.
     208      ! "wo(:, :, 1)" is for the average day-night field,
     209      ! "wo(:, :, 2)" is for daylight time.
     210      !$OMP THREADPRIVATE(wo)
     211
    207212! heat : chauffage solaire
    208213! heat0: chauffage solaire ciel clair
    … …  
    255260!$OMP THREADPRIVATE(snow_con)
    256261!
    257 ! sulfate_pi : SO4 aerosol concentration [ug/m3] (pre-industrial value)
    258 
    259       REAL,SAVE,ALLOCATABLE :: sulfate_pi(:, :)
    260 !$OMP THREADPRIVATE(sulfate_pi)
    261262      REAL,SAVE,ALLOCATABLE :: rlonPOS(:)
    262263!$OMP THREADPRIVATE(rlonPOS)
    … …  
    269270! ok_aie=T ->
    270271!       ok_ade=T -AIE=topswai-topswad
    271 !        ok_ade=F -AIE=topswai-topsw
     272!       ok_ade=F -AIE=topswai-topsw
    272273!
    273274!topswad, solswad : Aerosol direct effect
    … …  
    277278      REAL,SAVE,ALLOCATABLE :: topswai(:), solswai(:)
    278279!$OMP THREADPRIVATE(topswai,solswai)
    279       REAL,SAVE,ALLOCATABLE :: tau_ae(:,:,:), piz_ae(:,:,:)
    280 !$OMP THREADPRIVATE(tau_ae,piz_ae)
    281       REAL,SAVE,ALLOCATABLE :: cg_ae(:,:,:)
    282 !$OMP THREADPRIVATE(cg_ae)
    283 
    284 ! Les variables suivants uniquement pour un configuration avec INCA
    285 ! topswad_inca, solswad_inca : Aerosol direct effect
    286       REAL,SAVE,ALLOCATABLE :: topswad_inca(:), solswad_inca(:)
    287 !$OMP THREADPRIVATE(topswad_inca,solswad_inca)
    288 ! topswad0_inca, solswad0_inca : Aerosol direct effect
    289       REAL,SAVE,ALLOCATABLE :: topswad0_inca(:), solswad0_inca(:)
    290 !$OMP THREADPRIVATE(topswad0_inca,solswad0_inca)
    291 ! topswai_inca, solswai_inca : Aerosol indirect effect
    292       REAL,SAVE,ALLOCATABLE :: topswai_inca(:), solswai_inca(:)
    293 !$OMP THREADPRIVATE(topswai_inca,solswai_inca)
    294       REAL,SAVE,ALLOCATABLE :: topsw_inca(:,:), solsw_inca(:,:)
    295 !$OMP THREADPRIVATE(topsw_inca,solsw_inca)
    296       REAL,SAVE,ALLOCATABLE :: topsw0_inca(:,:), solsw0_inca(:,:)
    297 !$OMP THREADPRIVATE(topsw0_inca,solsw0_inca)
    298       REAL,SAVE,ALLOCATABLE :: tau_inca(:,:,:,:)
    299 !$OMP THREADPRIVATE(tau_inca)
    300       REAL,SAVE,ALLOCATABLE :: piz_inca(:,:,:,:)
    301 !$OMP THREADPRIVATE(piz_inca)
    302       REAL,SAVE,ALLOCATABLE :: cg_inca(:,:,:,:)
    303 !$OMP THREADPRIVATE(cg_inca)
     280
     281      REAL,SAVE,ALLOCATABLE :: tau_aero(:,:,:,:), piz_aero(:,:,:,:), cg_aero(:,:,:,:)
     282!$OMP THREADPRIVATE(tau_aero, piz_aero, cg_aero)
    304283      REAL,SAVE,ALLOCATABLE :: ccm(:,:,:)
    305284!$OMP THREADPRIVATE(ccm)
    … …  
    308287
    309288!======================================================================
    310 SUBROUTINE phys_state_var_init
     289SUBROUTINE phys_state_var_init(read_climoz)
    311290use dimphy
     291use aero_mod
    312292IMPLICIT NONE
     293
     294integer, intent(in)::  read_climoz
     295! read ozone climatology
     296! Allowed values are 0, 1 and 2
     297! 0: do not read an ozone climatology
     298! 1: read a single ozone climatology that will be used day and night
     299! 2: read two ozone climatologies, the average day and night
     300! climatology and the daylight climatology
     301
    313302#include "indicesol.h"
    314303#include "control.h"
    … …  
    388377      ALLOCATE(paire_ter(klon))
    389378      ALLOCATE(albsol1(klon), albsol2(klon))
    390       ALLOCATE(wo(klon,klev))
     379
     380      if (read_climoz <= 1) then
     381         ALLOCATE(wo(klon,klev, 1))
     382      else
     383         ! read_climoz == 2
     384         ALLOCATE(wo(klon,klev, 2))
     385      end if
     386     
    391387      ALLOCATE(clwcon0(klon,klev),rnebcon0(klon,klev))
    392388      ALLOCATE(heat(klon,klev), heat0(klon,klev))
    … …  
    402398      ALLOCATE(ibas_con(klon), itop_con(klon))
    403399      ALLOCATE(rain_con(klon), snow_con(klon))
    404 !
    405       ALLOCATE(sulfate_pi(klon, klev))
    406400      ALLOCATE(rlonPOS(klon))
    407401      ALLOCATE(newsst(klon))
    … …  
    409403      ALLOCATE(topswad(klon), solswad(klon))
    410404      ALLOCATE(topswai(klon), solswai(klon))
    411       ALLOCATE(tau_ae(klon,klev,2), piz_ae(klon,klev,2))
    412       ALLOCATE(cg_ae(klon,klev,2))
    413 
    414       IF (config_inca /= 'none') THEN
    415          ALLOCATE(topswad_inca(klon), solswad_inca(klon))
    416          ALLOCATE(topswad0_inca(klon), solswad0_inca(klon))
    417          ALLOCATE(topswai_inca(klon), solswai_inca(klon))
    418          ALLOCATE(topsw_inca(klon,9), solsw_inca(klon,9))
    419          ALLOCATE(topsw0_inca(klon,9), solsw0_inca(klon,9))
    420       END IF
    421       ! Following 4 variables are needed only by INCA but must be
    422       ! allocated as they exist in the phytrac argument list
    423       ALLOCATE(tau_inca(klon,klev,9,2))
    424       ALLOCATE(piz_inca(klon,klev,9,2))
    425       ALLOCATE(cg_inca(klon,klev,9,2))
    426       ALLOCATE(ccm(klon,klev,2))
     405      ALLOCATE(tau_aero(klon,klev,naero_grp,nbands),piz_aero(klon,klev,naero_grp,nbands),cg_aero(klon,klev,naero_grp,nbands))
     406      ALLOCATE(ccm(klon,klev,nbands))
    427407
    428408END SUBROUTINE phys_state_var_init
    … …  
    505485      deallocate(ibas_con, itop_con)
    506486      deallocate(rain_con, snow_con)
    507 !
    508       deallocate(sulfate_pi)
    509487      deallocate(rlonPOS)
    510488      deallocate(newsst)
    … …  
    512490      deallocate(topswad, solswad)
    513491      deallocate(topswai, solswai)
    514 
    515       deallocate(tau_ae, piz_ae)
    516       deallocate(cg_ae)
    517 
    518       IF (config_inca /= 'none') THEN
    519          deallocate(topswad_inca, solswad_inca)
    520          deallocate(topswad0_inca, solswad0_inca)
    521          deallocate(topswai_inca, solswai_inca)
    522          deallocate(topsw_inca, solsw_inca)
    523          deallocate(topsw0_inca, solsw0_inca)
    524       END IF
    525       deallocate(tau_inca)
    526       deallocate(piz_inca)
    527       deallocate(cg_inca)
     492      deallocate(tau_aero,piz_aero,cg_aero)
    528493      deallocate(ccm)
    529494       

  • LMDZ4/trunk/libf/phylmd/physiq.F

    r1149 r1279  
    1 c
     1! $Id$
     2!
    23c#define IO_DEBUG
    34
    45      SUBROUTINE physiq (nlon,nlev,
    5      .            debut,lafin,rjourvrai,gmtime,pdtphys,
     6     .            debut,lafin,jD_cur, jH_cur,pdtphys,
    67     .            paprs,pplay,pphi,pphis,presnivs,clesphy0,
    78     .            u,v,t,qx,
    … …  
    1112     .            , PVteta)
    1213
    13       USE ioipsl
     14      USE ioipsl, only: histbeg, histvert, histdef, histend, histsync,
     15     $     histwrite, ju2ymds, ymds2ju, ioget_year_len
    1416      USE comgeomphy
     17      USE phys_cal_mod
    1518      USE write_field_phy
    1619      USE dimphy
    … …  
    2831      USE fonte_neige_mod, ONLY  : fonte_neige_get_vars
    2932      USE phys_output_mod
     33      use open_climoz_m, only: open_climoz ! ozone climatology from a file
     34      use regr_pr_av_m, only: regr_pr_av
     35      use netcdf95, only: nf95_close
     36      use mod_phys_lmdz_mpi_data, only: is_mpi_root
     37      USE aero_mod
     38      use ozonecm_m, only: ozonecm ! ozone of J.-F. Royer
     39      use conf_phys_m, only: conf_phys
     40      use radlwsw_m, only: radlwsw
    3041
    3142      IMPLICIT none
    … …  
    5061c
    5162c nlon----input-I-nombre de points horizontaux
    52 c nlev----input-I-nombre de couches verticales
     63c nlev----input-I-nombre de couches verticales, doit etre egale a klev
    5364c debut---input-L-variable logique indiquant le premier passage
    5465c lafin---input-L-variable logique indiquant le dernier passage
    55 c rjour---input-R-numero du jour de l'experience
    56 c gmtime--input-R-temps universel dans la journee (0 a 86400 s)
     66c jD_cur       -R-jour courant a l'appel de la physique (jour julien)
     67c jH_cur       -R-heure courante a l'appel de la physique (jour julien)
    5768c pdtphys-input-R-pas d'integration pour la physique (seconde)
    5869c paprs---input-R-pression pour chaque inter-couche (en Pa)
    … …  
    104115      PARAMETER (ok_stratus=.FALSE.)
    105116c======================================================================
    106       LOGICAL, SAVE :: rnpb=.TRUE.
    107 c$OMP THREADPRIVATE(rnpb)
    108117      REAL amn, amx
    109118      INTEGER igout
    … …  
    181190      INTEGER nlon
    182191      INTEGER nlev
    183       REAL rjourvrai
    184       REAL gmtime
     192      REAL, intent(in):: jD_cur, jH_cur
     193
    185194      REAL pdtphys
    186195      LOGICAL debut, lafin
    … …  
    279288      real T2STD(klon,nlevSTD)
    280289c
    281 #include "radepsi.h"
    282290#include "radopt.h"
    283291c
    … …  
    523531      REAL clesphy0( longcles      )
    524532c
    525 c Variables quasi-arguments
    526 c
    527       REAL xjour
    528       SAVE xjour
    529 c$OMP THREADPRIVATE(xjour)
    530 c
    531 c
    532533c Variables propres a la physique
    533 c
    534 c      INTEGER radpas
    535 c      SAVE radpas                 ! frequence d'appel rayonnement
    536 ccccccccc$OMP THREADPRIVATE(radpas)
    537 c
    538 cc      INTEGER iflag_con
    539 c
    540534      INTEGER itap
    541535      SAVE itap                   ! compteur pour la physique
    … …  
    705699c Conditions aux limites
    706700c
    707       INTEGER julien
     701!
     702      REAL :: day_since_equinox
     703! Date de l'equinoxe de printemps
     704      INTEGER, parameter :: mth_eq=3, day_eq=21
     705      REAL :: jD_eq
     706
     707      LOGICAL, parameter :: new_orbit = .true.
     708
    708709c
    709710      INTEGER lmt_pas
    710711      SAVE lmt_pas                ! frequence de mise a jour
    711712c$OMP THREADPRIVATE(lmt_pas)
     713      real zmasse(klon, llm)
     714C     (column-density of mass of air in a cell, in kg m-2)
     715      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
    712716
    713717cIM sorties
    … …  
    731735      EXTERNAL hgardfou  ! verifier les temperatures
    732736      EXTERNAL nuage     ! calculer les proprietes radiatives
    733       EXTERNAL o3cm      ! initialiser l'ozone
     737CC      EXTERNAL o3cm      ! initialiser l'ozone
    734738      EXTERNAL orbite    ! calculer l'orbite terrestre
    735       EXTERNAL ozonecm   ! prescrire l'ozone
    736739      EXTERNAL phyetat0  ! lire l'etat initial de la physique
    737740      EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
    738       EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
    739741      EXTERNAL suphel    ! initialiser certaines constantes
    740742      EXTERNAL transp    ! transport total de l'eau et de l'energie
    … …  
    877879c
    878880      REAL ratqss(klon,klev),ratqsc(klon,klev)
    879       real ratqsbas,ratqshaut
    880       save ratqsbas,ratqshaut
    881 c$OMP THREADPRIVATE(ratqsbas,ratqshaut)
     881      real ratqsbas,ratqshaut,tau_ratqs
     882      save ratqsbas,ratqshaut,tau_ratqs
     883c$OMP THREADPRIVATE(ratqsbas,ratqshaut,tau_ratqs)
    882884      real zpt_conv(klon,klev)
    883885
    … …  
    887889      logical ok_newmicro
    888890      save ok_newmicro
     891      real ref_liq(klon,klev), ref_ice(klon,klev)
    889892c$OMP THREADPRIVATE(ok_newmicro)
    890893      save fact_cldcon,facttemps
    … …  
    972975      REAL zx_tmp_fiNC(klon,nlevSTD)
    973976c#endif
    974       REAL*8 zx_tmp2_fi3d(klon,klev) ! variable temporaire pour champs 3D
     977      REAL(KIND=8) zx_tmp2_fi3d(klon,klev) ! variable temporaire pour champs 3D
    975978      REAL zx_tmp_2d(iim,jjmp1), zx_tmp_3d(iim,jjmp1,klev)
    976979      REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1)
    … …  
    10561059      CHARACTER*40 t2mincels, t2maxcels       !t2m min., t2m max
    10571060      CHARACTER*40 tinst, tave, typeval
    1058 cjq   Aerosol effects (Johannes Quaas, 27/11/2003)
    1059       REAL sulfate(klon, klev) ! SO4 aerosol concentration [ug/m3]
    1060 
    10611061      REAL cldtaupi(klon,klev)  ! Cloud optical thickness for pre-industrial (pi) aerosols
    10621062
    … …  
    10671067
    10681068      ! Aerosol optical properties
    1069 
    1070       ! Aerosol optical properties by INCA model
    1071       CHARACTER*4              ::    rfname(9)
    1072       REAL aerindex(klon)       ! POLDER aerosol index
    1073      
     1069      CHARACTER*4, DIMENSION(naero_grp) :: rfname
     1070      REAL, DIMENSION(klon)          :: aerindex     ! POLDER aerosol index
     1071      REAL, DIMENSION(klon,klev)     :: mass_solu_aero    ! total mass concentration for all soluble aerosols[ug/m3]
     1072      REAL, DIMENSION(klon,klev)     :: mass_solu_aero_pi ! - " - (pre-industrial value)
     1073      INTEGER :: naero ! aerosol species
     1074
    10741075      ! Parameters
    10751076      LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not
    … …  
    10801081                                      ! false : lecture des aerosol dans un fichier
    10811082c$OMP THREADPRIVATE(aerosol_couple)   
    1082 
     1083      INTEGER, SAVE :: flag_aerosol
     1084c$OMP THREADPRIVATE(flag_aerosol)
     1085      LOGICAL, SAVE :: new_aod
     1086c$OMP THREADPRIVATE(new_aod)
     1087   
    10831088c
    10841089c Declaration des constantes et des fonctions thermodynamiques
    … …  
    10861091      LOGICAL,SAVE :: first=.true.
    10871092c$OMP THREADPRIVATE(first)
     1093
     1094      integer iunit
     1095
     1096      integer, save::  read_climoz ! read ozone climatology
     1097C     Allowed values are 0, 1 and 2
     1098C     0: do not read an ozone climatology
     1099C     1: read a single ozone climatology that will be used day and night
     1100C     2: read two ozone climatologies, the average day and night
     1101C     climatology and the daylight climatology
     1102
     1103      integer, save:: ncid_climoz ! NetCDF file containing ozone climatologies
     1104
     1105      real, pointer, save:: press_climoz(:)
     1106!     edges of pressure intervals for ozone climatologies, in Pa, in strictly
     1107!     ascending order
     1108
     1109      integer, save:: co3i = 0
     1110!     time index in NetCDF file of current ozone fields
     1111c$OMP THREADPRIVATE(co3i)
     1112
     1113      integer ro3i
     1114!     required time index in NetCDF file for the ozone fields, between 1
     1115!     and 360
     1116
    10881117#include "YOMCST.h"
    10891118#include "YOETHF.h"
    … …  
    10961125cIM 100106 END : pouvoir sortir les ctes de la physique
    10971126c
     1127!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1128c Declarations pour Simulateur COSP
     1129c============================================================
     1130      real :: mr_ozone(klon,klev)
    10981131c======================================================================
    10991132! Ecriture eventuelle d'un profil verticale en entree de la physique.
    … …  
    11061139         write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
    11071140         write(lunout,*)
    1108      s 'nlon,nlev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys'
     1141     s 'nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys'
    11091142         write(lunout,*)
    1110      s  nlon,nlev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys
    1111 
    1112          write(lunout,*) 'papers, play, phi, u, v, t, omega'
    1113          do k=1,nlev
     1143     s  nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys
     1144
     1145         write(lunout,*) 'paprs, play, phi, u, v, t'
     1146         do k=1,klev
    11141147            write(lunout,*) paprs(igout,k),pplay(igout,k),pphi(igout,k),
    1115      s   u(igout,k),v(igout,k),t(igout,k),omega(igout,k)
     1148     s   u(igout,k),v(igout,k),t(igout,k)
    11161149         enddo
    11171150         write(lunout,*) 'ovap (g/kg),  oliq (g/kg)'
    1118          do k=1,nlev
     1151         do k=1,klev
    11191152            write(lunout,*) qx(igout,k,1)*1000,qx(igout,k,2)*1000.
    11201153         enddo
    … …  
    11321165
    11331166      torsfc=0.
     1167      forall (k=1: llm) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
    11341168
    11351169      if (first) then
    … …  
    11401174      print*, 'Allocation des variables locales et sauvegardees'
    11411175      call phys_local_var_init
    1142       call phys_state_var_init
     1176c     appel a la lecture du run.def physique
     1177      call conf_phys(ok_journe, ok_mensuel,
     1178     .     ok_instan, ok_hf,
     1179     .     ok_LES,
     1180     .     solarlong0,seuil_inversion,
     1181     .     fact_cldcon, facttemps,ok_newmicro,iflag_radia,
     1182     .     iflag_cldcon,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs,
     1183     .     ok_ade, ok_aie, aerosol_couple,
     1184     .     flag_aerosol, new_aod,
     1185     .     bl95_b0, bl95_b1,
     1186     .     iflag_thermals,nsplit_thermals,tau_thermals,
     1187     .     iflag_thermals_ed,iflag_thermals_optflux,
     1188c     nv flags pour la convection et les poches froides
     1189     .     iflag_coupl,iflag_clos,iflag_wake, read_climoz)
     1190      call phys_state_var_init(read_climoz)
    11431191      print*, '================================================='
    11441192
    … …  
    11561204        first=.false.
    11571205
    1158       endif  ! fisrt
     1206      endif  ! first
    11591207
    11601208       modname = 'physiq'
    … …  
    11751223
    11761224c======================================================================
    1177       xjour = rjourvrai
     1225! Gestion calendrier : mise a jour du module phys_cal_mod
     1226!
     1227      CALL phys_cal_update(jD_cur,jH_cur)
     1228
    11781229c
    11791230c Si c'est le debut, il faut initialiser plusieurs choses
    … …  
    11811232c
    11821233       IF (debut) THEN
    1183 C
    11841234!rv
    11851235cCRinitialisation de wght_th et lalim_conv pour la definition de la couche alimentation
    … …  
    11901240         u10m(:,:)=0.
    11911241         v10m(:,:)=0.
    1192          piz_ae(:,:,:)=0.
    1193          tau_ae(:,:,:)=0.
    1194          cg_ae(:,:,:)=0.
    11951242         rain_con(:)=0.
    11961243         snow_con(:)=0.
    1197          bl95_b0=0.
    1198          bl95_b1=0.
    11991244         topswai(:)=0.
    12001245         topswad(:)=0.
    … …  
    12051250         wmax_th(:)=0.
    12061251         tau_overturning_th(:)=0.
     1252
    12071253         IF (config_inca /= 'none') THEN
    1208             tau_inca(:,:,:,:) = 0.
    1209             piz_inca(:,:,:,:) = 0.
    1210             cg_inca(:,:,:,:)  = 0.
    1211             ccm(:,:,:)        = 0.
    1212             topswai_inca(:)   = 0.
    1213             topswad_inca(:)   = 0.
    1214             topswad0_inca(:)  = 0.
    1215             topsw_inca(:,:)   = 0.
    1216             topsw0_inca(:,:)  = 0.
    1217             solswai_inca(:)   = 0.
    1218             solswad_inca(:)   = 0.
    1219             solswad0_inca(:)  = 0.
    1220             solsw_inca(:,:)   = 0.
    1221             solsw0_inca(:,:)  = 0.
     1254            ! jg : initialisation jusqu'au ces variables sont dans restart
     1255            ccm(:,:,:) = 0.
     1256            tau_aero(:,:,:,:) = 0.
     1257            piz_aero(:,:,:,:) = 0.
     1258            cg_aero(:,:,:,:) = 0.
    12221259         END IF
    12231260
    … …  
    12301267         IF (ip_ebil_phy.ge.1) d_h_vcol_phy=0.
    12311268c
    1232 c appel a la lecture du run.def physique
    1233 c
    1234          call conf_phys(ok_journe, ok_mensuel,
    1235      .                  ok_instan, ok_hf,
    1236      .                  ok_LES,
    1237      .                  solarlong0,seuil_inversion,
    1238      .                  fact_cldcon, facttemps,ok_newmicro,iflag_radia,
    1239      .                  iflag_cldcon,iflag_ratqs,ratqsbas,ratqshaut,
    1240      .                  ok_ade, ok_aie, aerosol_couple,
    1241      .                  bl95_b0, bl95_b1,
    1242      .                  iflag_thermals,nsplit_thermals,tau_thermals,
    1243      .                  iflag_thermals_ed,iflag_thermals_optflux,
    1244 cnv flags pour la convection et les poches froides
    1245      .                   iflag_coupl,iflag_clos,iflag_wake)
    1246 
    12471269      print*,'iflag_coupl,iflag_clos,iflag_wake',
    12481270     .   iflag_coupl,iflag_clos,iflag_wake
    … …  
    13771399         ENDIF
    13781400
    1379            rugoro=0.
     1401           DO i=1,klon
     1402             rugoro(i) = f_rugoro * MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
     1403           ENDDO
     1404
    13801405c34EK
    13811406         IF (ok_orodr) THEN
    1382 
    1383            rugoro=0.
    13841407
    13851408!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    14131436     .                   lmt_pas
    14141437c
    1415 cIM200505        ecrit_mth = NINT(86400./dtime *ecritphy)  ! tous les ecritphy jours
    1416 c        IF (ok_mensuel) THEN
    1417 c        WRITE(lunout,*)'La frequence de sortie mensuelle est de ',
    1418 c    .                   ecrit_mth
    1419 c        ENDIF
    1420 c        ecrit_day = NINT(86400./dtime *1.0)  ! tous les jours
    1421 c        IF (ok_journe) THEN
    1422 c        WRITE(lunout,*)'La frequence de sortie journaliere est de ',
    1423 c    .                   ecrit_day
    1424 c        ENDIF
    1425 cIM 130904 BEG
    1426 cIM 080205      ecrit_hf = 86400./dtime *0.25  ! toutes les 6h
    1427 cIM 170305     
    1428 c        ecrit_hf = 86400./dtime/12.  ! toutes les 2h
    1429 cIM 230305     
    1430 cIM200505        ecrit_hf = 86400./dtime *0.25  ! toutes les 6h
    1431 c
    1432 cIM200505        ecrit_hf2mth = ecrit_day/ecrit_hf*30
    1433 c
    1434 cIM200505        IF (ok_journe) THEN
    1435 cIM200505        WRITE(lunout,*)'La frequence de sortie hf est de ',
    1436 cIM200505    .                   ecrit_hf
    1437 cIM200505        ENDIF
    1438 cIM 130904 END
    1439 ccc         ecrit_ins = NINT(86400./dtime *0.5)  ! 2 fois par jour
    1440 ccc         ecrit_ins = NINT(86400./dtime *0.25)  ! 4 fois par jour
    1441 c        ecrit_ins = NINT(86400./dtime/48.)  ! a chaque pas de temps ==> PB. dans time_counter pour 1mois
    1442 c        ecrit_ins = NINT(86400./dtime/12.)  ! toutes les deux heures
    1443 cIM200505        ecrit_ins = NINT(86400./dtime/8.)  ! toutes les trois heures
    1444 cIM200505        IF (ok_instan) THEN
    1445 cIM200505        WRITE(lunout,*)'La frequence de sortie instant. est de ',
    1446 cIM200505    .                   ecrit_ins
    1447 cIM200505        ENDIF
    1448 cIM200505        ecrit_reg = NINT(86400./dtime *0.25)  ! 4 fois par jour
    1449 cIM200505        IF (ok_region) THEN
    1450 cIM200505        WRITE(lunout,*)'La frequence de sortie region est de ',
    1451 cIM200505    .                   ecrit_reg
    1452 cIM200505        ENDIF
    1453 cIM 030306 BEG
    1454 cIM ecrit_hf2mth = nombre de pas de temps de calcul de hf par mois apres lequel on ecrit
    1455 cIM : ne pas modifier ecrit_hf2mth
    1456 c
    1457 cIM 250308bad guide        ecrit_hf2mth = 30*1/ecrit_hf
    1458          ecrit_hf2mth = ecrit_mth/ecrit_hf
    1459 c ecrit_ins en secondes, chaque pas de temps de la physique
    1460          ecrit_ins = dtime
    1461 cIM on passe les frequences de jours en secondes : ecrit_ins, ecrit_hf, ecrit_day, ecrit_mth, ecrit_tra, ecrit_reg
    1462          ecrit_hf = ecrit_hf * un_jour
    1463 !IM
    1464          IF(ecrit_day.LE.1.) THEN
    1465           ecrit_day = ecrit_day * un_jour !en secondes
    1466          ENDIF
    1467 !IM
    1468          ecrit_mth = ecrit_mth * un_jour
    1469          ecrit_reg = ecrit_reg * un_jour
    1470          ecrit_tra = ecrit_tra * un_jour
    1471          ecrit_ISCCP = ecrit_ISCCP * un_jour
    1472          ecrit_LES = ecrit_LES * un_jour
    1473 c
    1474          PRINT*,'physiq ecrit_ hf day mth reg tra ISCCP hf2mth',
    1475      .   ecrit_hf,ecrit_day,ecrit_mth,ecrit_reg,ecrit_tra,ecrit_ISCCP,
    1476      .   ecrit_hf2mth
    14771438cIM 030306 END
    14781439
    … …  
    14941455c$OMP MASTER
    14951456       call phys_output_open(jjmp1,nlevSTD,clevSTD,nbteta,
    1496      &                        ctetaSTD,dtime,presnivs,ok_veget,
     1457     &                        ctetaSTD,dtime,ok_veget,
    14971458     &                        type_ocean,iflag_pbl,ok_mensuel,ok_journe,
    1498      &                        ok_hf,ok_instan,ok_LES,ok_ade,ok_aie)
     1459     &                        ok_hf,ok_instan,ok_LES,ok_ade,ok_aie,
     1460     &                        read_climoz, new_aod, aerosol_couple)
    14991461c$OMP END MASTER
    15001462c$OMP BARRIER
    … …  
    15141476#endif
    15151477
     1478cIM 250308bad guide        ecrit_hf2mth = 30*1/ecrit_hf
     1479         ecrit_hf2mth = ecrit_mth/ecrit_hf
     1480
     1481         ecrit_hf = ecrit_hf * un_jour
     1482!IM
     1483         IF(ecrit_day.LE.1.) THEN
     1484          ecrit_day = ecrit_day * un_jour !en secondes
     1485         ENDIF
     1486!IM
     1487         ecrit_mth = ecrit_mth * un_jour
     1488         ecrit_ins = ecrit_ins * un_jour
     1489         ecrit_reg = ecrit_reg * un_jour
     1490         ecrit_tra = ecrit_tra * un_jour
     1491         ecrit_ISCCP = ecrit_ISCCP * un_jour
     1492         ecrit_LES = ecrit_LES * un_jour
     1493c
     1494         PRINT*,'physiq ecrit_ hf day mth reg tra ISCCP hf2mth',
     1495     .   ecrit_hf,ecrit_day,ecrit_mth,ecrit_reg,ecrit_tra,ecrit_ISCCP,
     1496     .   ecrit_hf2mth
     1497cIM 030306 END
     1498
     1499
    15161500cXXXPB Positionner date0 pour initialisation de ORCHIDEE
    1517       date0 = zjulian
    1518 C      date0 = day_ini
     1501      date0 = jD_ref
    15191502      WRITE(*,*) 'physiq date0 : ',date0
    15201503c
    … …  
    15341517         CALL VTe(VTphysiq)
    15351518         CALL VTb(VTinca)
    1536          iii = MOD(NINT(xjour),360)
    1537          calday = FLOAT(iii) + gmtime
    1538          WRITE(lunout,*) 'initial time ', xjour, calday
     1519!         iii = MOD(NINT(xjour),360)
     1520!         calday = FLOAT(iii) + jH_cur
     1521         calday = FLOAT(days_elapsed) + jH_cur
     1522         WRITE(lunout,*) 'initial time chemini', days_elapsed, calday
    15391523
    15401524         CALL chemini(
    … …  
    15501534     $                   pdtphys,
    15511535     $                   annee_ref,
    1552      $                   day_ini)
     1536     $                   day_ref,
     1537     $                   itau_phy)
    15531538
    15541539         CALL VTe(VTinca)
    … …  
    15641549      call iniradia(klon,klev,paprs(1,1:klev+1))
    15651550
     1551C$omp single
     1552      if (read_climoz >= 1) then
     1553         call open_climoz(ncid_climoz, press_climoz)
     1554      END IF
     1555C$omp end single
    15661556      ENDIF
    15671557!
    … …  
    15721562!
    15731563      itap   = itap + 1
    1574       julien = MOD(NINT(xjour),360)
    1575       if (julien .eq. 0) julien = 360
    1576 
    15771564!
    15781565! Update fraction of the sub-surfaces (pctsrf) and
    … …  
    15801567! on the surface fraction.
    15811568!
    1582       CALL change_srf_frac(itap, dtime, julien,
     1569      CALL change_srf_frac(itap, dtime, days_elapsed+1,
    15831570     *     pctsrf, falb1, falb2, ftsol, u10m, v10m, pbl_tke)
    1584 
    15851571
    15861572! Tendances bidons pour les processus qui n'affectent pas certaines
    … …  
    17311717c Prescrire l'ozone et calculer l'albedo sur l'ocean.
    17321718c
    1733       IF (MOD(itap-1,lmt_pas) .EQ. 0) THEN
    1734          if(prt_level.ge.1) WRITE(lunout,*)' PHYS cond  julien ',julien
    1735          CALL ozonecm( FLOAT(julien), rlat, paprs, wo)
     1719      if (read_climoz >= 1) then
     1720C        Ozone from a file
     1721!        Update required ozone index:
     1722         ro3i = int((days_elapsed + jh_cur - jh_1jan)
     1723     $        / ioget_year_len(year_cur) * 360.) + 1
     1724         if (ro3i == 361) ro3i = 360
     1725C        (This should never occur, except perhaps because of roundup
     1726C        error. See documentation.)
     1727         if (ro3i /= co3i) then
     1728C           Update ozone field:
     1729            if (read_climoz == 1) then
     1730               call regr_pr_av(ncid_climoz, (/"tro3"/), julien=ro3i,
     1731     $              press_in_edg=press_climoz, paprs=paprs, v3=wo)
     1732            else
     1733C              read_climoz == 2
     1734               call regr_pr_av(ncid_climoz,
     1735     $              (/"tro3         ", "tro3_daylight"/),
     1736     $              julien=ro3i, press_in_edg=press_climoz, paprs=paprs,
     1737     $              v3=wo)
     1738            end if
     1739!           Convert from mole fraction of ozone to column density of ozone in a
     1740!           cell, in kDU:
     1741            forall (l = 1: read_climoz) wo(:, :, l) = wo(:, :, l)
     1742     $           * rmo3 / rmd * zmasse / dobson_u / 1e3
     1743C           (By regridding ozone values for LMDZ only once every 360th of
     1744C           year, we have already neglected the variation of pressure in one
     1745C           360th of year. So do not recompute "wo" at each time step even if
     1746C           "zmasse" changes a little.)
     1747            co3i = ro3i
     1748         end if
     1749      elseif (MOD(itap-1,lmt_pas) == 0) THEN
     1750C        Once per day, update ozone from Royer:
     1751         wo(:, :, 1) = ozonecm(rlat, paprs, rjour=real(days_elapsed+1))
    17361752      ENDIF
    17371753c
    … …  
    17741790! doit donc etre placé avant radlwsw et pbl_surface
    17751791
     1792! calcul selon la routine utilisee pour les planetes
     1793      if (new_orbit) then
     1794        call ymds2ju(year_cur, mth_eq, day_eq,0., jD_eq)
     1795        day_since_equinox = (jD_cur + jH_cur) - jD_eq
     1796!        day_since_equinox = (jD_cur) - jD_eq
     1797        call solarlong(day_since_equinox, zlongi, dist)
     1798      else     
     1799! calcul selon la routine utilisee pour l'AR4
    17761800!   choix entre calcul de la longitude solaire vraie ou valeur fixee a
    17771801!   solarlong0
    1778 
    1779       if (solarlong0<-999.) then
    1780          CALL orbite(FLOAT(julien),zlongi,dist)
    1781       else
    1782          zlongi=solarlong0  ! longitude solaire vraie
    1783          dist=1.            ! distance au soleil / moyenne
     1802        if (solarlong0<-999.) then
     1803           CALL orbite(FLOAT(days_elapsed+1),zlongi,dist)
     1804        else
     1805           zlongi=solarlong0  ! longitude solaire vraie
     1806           dist=1.            ! distance au soleil / moyenne
     1807        endif
    17841808      endif
    1785 
    1786       if(prt_level.ge.1) print*,'Longitude solaire ',zlongi,solarlong0
     1809      if(prt_level.ge.1)                                                &
     1810     &    write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist
    17871811
    17881812!  Avec ou sans cycle diurne
    17891813      IF (cycle_diurne) THEN
    17901814        zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
    1791         CALL zenang(zlongi,gmtime,zdtime,rlat,rlon,rmu0,fract)
     1815        CALL zenang(zlongi,jH_cur,zdtime,rlat,rlon,rmu0,fract)
    17921816      ELSE
    17931817        CALL angle(zlongi, rlat, fract, rmu0)
    … …  
    18221846
    18231847      CALL pbl_surface(
    1824      e     dtime,     date0,     itap,    julien,
     1848     e     dtime,     date0,     itap,    days_elapsed+1,
    18251849     e     debut,     lafin,
    18261850     e     rlon,      rlat,      rugoro,  rmu0,     
    … …  
    19331957         END DO
    19341958      END DO
     1959      if (prt_level.ge.1) write(lunout,*) 'omega(igout, :) = ',
     1960     $     omega(igout, :)
    19351961
    19361962      IF (iflag_con.EQ.1) THEN
    … …  
    21192145
    21202146            if (itop_con(i).gt.klev-3) then
    2121                print*,'La convection monte trop haut '
    2122                print*,'itop_con(,',i,',)=',itop_con(i)
     2147              if(prt_level >= 9) then
     2148                write(lunout,*)'La convection monte trop haut '
     2149                write(lunout,*)'itop_con(,',i,',)=',itop_con(i)
     2150              endif
    21232151            endif
    21242152          ENDDO
    … …  
    25192547         enddo
    25202548
    2521 !   les ratqs sont une conbinaison de ratqss et ratqsc
    2522 !   1800s, en dur pour le moment, est le temps de
    2523 !   relaxation des ratqs
    2524 
    2525          facteur=exp(-pdtphys/1800.)
    2526 
    2527          print*,'WARNING ratqs a revoir '
     2549!   les ratqs sont une combinaison de ratqss et ratqsc
     2550       print*,'PHYLMD NOUVEAU TAU_RATQS ',tau_ratqs
     2551
     2552         if (tau_ratqs>1.e-10) then
     2553            facteur=exp(-pdtphys/tau_ratqs)
     2554         else
     2555            facteur=0.
     2556         endif
    25282557         ratqs(:,:)=ratqsc(:,:)*(1.-facteur)+ratqs(:,:)*facteur
    2529          ratqs(:,:)=sqrt(ratqs(:,:)**2+ratqss(:,:)**2)
    2530 
     2558!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2559! FH 22/09/2009
     2560! La ligne ci-dessous faisait osciller le modele et donnait une solution
     2561! assymptotique bidon et dépendant fortement du pas de temps.
     2562!        ratqs(:,:)=sqrt(ratqs(:,:)**2+ratqss(:,:)**2)
     2563!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2564         ratqs(:,:)=max(ratqs(:,:),ratqss(:,:))
    25312565      else
    25322566!   on ne prend que le ratqs stable pour fisrtilp
    … …  
    26582692cjq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
    26592693      IF (ok_ade.OR.ok_aie) THEN
    2660        IF ( .NOT. aerosol_couple ) THEN
    2661          ! Get sulfate aerosol distribution
    2662          CALL readsulfate(rjourvrai, debut, sulfate)
    2663          CALL readsulfate_preind(rjourvrai, debut, sulfate_pi)
    2664 
    2665          ! Calculate aerosol optical properties (Olivier Boucher)
    2666          CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl,
    2667      .        tau_ae, piz_ae, cg_ae, aerindex)
    2668        ENDIF
     2694         IF (.NOT. aerosol_couple)
     2695     &        CALL readaerosol_optic(
     2696     &        debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref,
     2697     &        pdtphys, pplay, paprs, t_seri, rhcl, presnivs,
     2698     &        mass_solu_aero, mass_solu_aero_pi,
     2699     &        tau_aero, piz_aero, cg_aero,
     2700     &        tausum_aero, tau3d_aero)
    26692701      ELSE
    2670         tau_ae(:,:,:)=0.0
    2671         piz_ae(:,:,:)=0.0
    2672         cg_ae(:,:,:)=0.0
     2702         tau_aero(:,:,:,:) = 0.
     2703         piz_aero(:,:,:,:) = 0.
     2704         cg_aero(:,:,:,:)  = 0.
    26732705      ENDIF
    26742706
    … …  
    27912823         CALL VTe(VTphysiq)
    27922824         CALL VTb(VTinca)
    2793          calday = FLOAT(julien) + gmtime
     2825         calday = FLOAT(days_elapsed + 1) + jH_cur
    27942826
    27952827         IF (config_inca == 'aero') THEN
    27962828            CALL AEROSOL_METEO_CALC(
    27972829     $           calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs,
    2798      $           prfl,psfl,pctsrf,airephy,xjour,rlat,rlon,u10m,v10m)
     2830     $           prfl,psfl,pctsrf,airephy,rlat,rlon,u10m,v10m)
    27992831         END IF
    28002832
    … …  
    28022834
    28032835         CALL chemhook_begin (calday,
    2804      $                          julien,
    2805      $                          gmtime,
     2836     $                          days_elapsed+1,
     2837     $                          jH_cur,
    28062838     $                          pctsrf(1,1),
    28072839     $                          rlat,
    … …  
    28152847     $                          u,
    28162848     $                          v,
    2817      $                          wo,
     2849     $                          wo(:, :, 1),
    28182850     $                          q_seri,
    28192851     $                          zxtsol,
    … …  
    28472879
    28482880      IF (aerosol_couple) THEN
    2849          sulfate(:,:) = ccm(:,:,1)
    2850          sulfate_pi(:,:) = ccm(:,:,2)
    2851       ENDIF
     2881         mass_solu_aero(:,:)    = ccm(:,:,1)
     2882         mass_solu_aero_pi(:,:) = ccm(:,:,2)
     2883      END IF
    28522884
    28532885      if (ok_newmicro) then
    … …  
    28572889     .            flwp, fiwp, flwc, fiwc,
    28582890     e            ok_aie,
    2859      e            sulfate, sulfate_pi,
     2891     e            mass_solu_aero, mass_solu_aero_pi,
    28602892     e            bl95_b0, bl95_b1,
    2861      s            cldtaupi, re, fl)
     2893     s            cldtaupi, re, fl, ref_liq, ref_ice)
    28622894      else
    28632895      CALL nuage (paprs, pplay,
    … …  
    28652897     .            cldh, cldl, cldm, cldt, cldq,
    28662898     e            ok_aie,
    2867      e            sulfate, sulfate_pi,
     2899     e            mass_solu_aero, mass_solu_aero_pi,
    28682900     e            bl95_b0, bl95_b1,
    28692901     s            cldtaupi, re, fl)
    … …  
    28952927      IF (aerosol_couple) THEN
    28962928#ifdef INCA
    2897       CALL radlwsw_inca
    2898      e            (kdlon,kflev,dist, rmu0, fract, solaire,
    2899      e             paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri,
    2900      e             wo,
    2901      e             cldfra, cldemi, cldtau,
    2902      s             heat,heat0,cool,cool0,radsol,albpla,
    2903      s             topsw,toplw,solsw,sollw,
    2904      s             sollwdown,
    2905      s             topsw0,toplw0,solsw0,sollw0,
    2906      s             lwdn0, lwdn, lwup0, lwup,
    2907      s             swdn0, swdn, swup0, swup,
    2908      e             ok_ade, ok_aie,
    2909      e             tau_inca, piz_inca, cg_inca,
    2910      s             topswad_inca, solswad_inca,
    2911      s             topswad0_inca, solswad0_inca,
    2912      s             topsw_inca, topsw0_inca,
    2913      s             solsw_inca, solsw0_inca,
    2914      e             cldtaupi,
    2915      s             topswai_inca, solswai_inca)
     2929         CALL radlwsw_inca
     2930     e        (kdlon,kflev,dist, rmu0, fract, solaire,
     2931     e        paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri,
     2932     e        wo(:, :, 1),
     2933     e        cldfra, cldemi, cldtau,
     2934     s        heat,heat0,cool,cool0,radsol,albpla,
     2935     s        topsw,toplw,solsw,sollw,
     2936     s        sollwdown,
     2937     s        topsw0,toplw0,solsw0,sollw0,
     2938     s        lwdn0, lwdn, lwup0, lwup,
     2939     s        swdn0, swdn, swup0, swup,
     2940     e        ok_ade, ok_aie,
     2941     e        tau_aero, piz_aero, cg_aero,
     2942     s        topswad_aero, solswad_aero,
     2943     s        topswad0_aero, solswad0_aero,
     2944     s        topsw_aero, topsw0_aero,
     2945     s        solsw_aero, solsw0_aero,
     2946     e        cldtaupi,
     2947     s        topswai_aero, solswai_aero)
     2948           
    29162949#endif
    29172950      ELSE
    2918       CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS)
    2919      e            (dist, rmu0, fract,
    2920      e             paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri,
    2921      e             wo,
    2922      e             cldfra, cldemi, cldtau,
    2923      s             heat,heat0,cool,cool0,radsol,albpla,
    2924      s             topsw,toplw,solsw,sollw,
    2925      s             sollwdown,
    2926      s             topsw0,toplw0,solsw0,sollw0,
    2927      s             lwdn0, lwdn, lwup0, lwup,
    2928      s             swdn0, swdn, swup0, swup,
    2929      e             ok_ade, ok_aie, ! new for aerosol radiative effects
    2930      e             tau_ae, piz_ae, cg_ae, ! ="=
    2931      s             topswad, solswad, ! ="=
    2932      e             cldtaupi, ! ="=
    2933      s             topswai, solswai,zqsat,flwc,fiwc) ! ="=
    2934       ENDIF
     2951
     2952         CALL radlwsw
     2953     e        (dist, rmu0, fract,
     2954     e        paprs, pplay,zxtsol,albsol1, albsol2,
     2955     e        t_seri,q_seri,wo,
     2956     e        cldfra, cldemi, cldtau,
     2957     e        ok_ade, ok_aie,
     2958     e        tau_aero, piz_aero, cg_aero,
     2959     e        cldtaupi,new_aod,
     2960     e        zqsat, flwc, fiwc,
     2961     s        heat,heat0,cool,cool0,radsol,albpla,
     2962     s        topsw,toplw,solsw,sollw,
     2963     s        sollwdown,
     2964     s        topsw0,toplw0,solsw0,sollw0,
     2965     s        lwdn0, lwdn, lwup0, lwup,
     2966     s        swdn0, swdn, swup0, swup,
     2967     s        topswad_aero, solswad_aero,
     2968     s        topswai_aero, solswai_aero,
     2969     o        topswad0_aero, solswad0_aero,
     2970     o        topsw_aero, topsw0_aero,
     2971     o        solsw_aero, solsw0_aero,
     2972     o        topswcf_aero, solswcf_aero)
     2973         
     2974
     2975      ENDIF ! aerosol_couple
    29352976      itaprad = 0
    2936       ENDIF
     2977      ENDIF ! MOD(itaprad,radpas)
    29372978      itaprad = itaprad + 1
    29382979
    … …  
    31233164cIM calcul composantes axiales du moment angulaire et couple des montagnes
    31243165c
    3125       IF (is_sequential .AND. ok_orodr .AND. ok_orolf ) THEN
     3166      IF (is_sequential) THEN
    31263167     
    3127         CALL aaam_bud (27,klon,klev,rjourvrai,gmtime,
     3168        CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur,
    31283169     C                 ra,rg,romega,
    31293170     C                 rlat,rlon,pphis,
    … …  
    31433184c
    31443185c
     3186!====================================================================
     3187! Interface Simulateur COSP (Calipso, ISCCP, MISR, ..)
     3188!====================================================================
     3189! Abderrahmane 24.08.09
     3190
     3191      IF (ok_cosp) THEN
     3192! adeclarer
     3193#ifdef CPP_COSP
     3194       IF (MOD(itap,NINT(freq_cosp/dtime)).EQ.0) THEN
     3195
     3196       print*,'freq_cosp',freq_cosp
     3197          mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
     3198!       print*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=',
     3199!     s        ref_liq,ref_ice
     3200          call phys_cosp(itap,dtime,freq_cosp,
     3201     $                 ecrit_mth,ecrit_day,ecrit_hf,overlap,
     3202     $                   klon,klev,rlon,rlat,presnivs,
     3203     $                   ref_liq,ref_ice,
     3204     $                   pctsrf(:,is_ter)+pctsrf(:,is_lic),
     3205     $                   zu10m,zv10m,
     3206     $                   zphi,paprs(:,1:klev),pplay,zxtsol,t_seri,
     3207     $                   qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc,
     3208     $                   prfl(:,1:klev),psfl(:,1:klev),
     3209     $                   pmflxr(:,1:klev),pmflxs(:,1:klev),
     3210     $                   mr_ozone,cldtau, cldemi)
     3211!     L          calipso2D,calipso3D,cfadlidar,parasolrefl,atb,betamol,
     3212!     L          cfaddbze,clcalipso2,dbze,cltlidarradar,
     3213!     M          clMISR,
     3214!     R          clisccp2,boxtauisccp,boxptopisccp,tclisccp,ctpisccp,
     3215!     I          tauisccp,albisccp,meantbisccp,meantbclrisccp)
     3216
     3217         ENDIF
     3218
     3219#endif
     3220       ENDIF  !ok_cosp
     3221!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    31453222cAA
    31463223cAA Installation de l'interface online-offline pour traceurs
    … …  
    31503227c====================================================================
    31513228C
    3152       IF (config_inca /= 'none') rnpb=.FALSE.
    3153 
    3154       call phytrac (     rnpb,
    3155      I                   itap,
    3156      I                   julien,
    3157      I                   gmtime,
    3158      I                   debut,
    3159      I                   lafin,
    3160      I                   nlon,
    3161      I                   nlev,
    3162      I                   dtime,
    3163      I                   u,
    3164      I                   v,
    3165      I                   t,
    3166      I                   paprs,
    3167      I                   pplay,
    3168      I                   pmfu,
    3169      I                   pmfd,
    3170      I                   pen_u,
    3171      I                   pde_u,
    3172      I                   pen_d,
    3173      I                   pde_d,
    3174      I                   cdragh,
    3175      I                   coefh,
    3176      I                   fm_therm,
    3177      I                   entr_therm,
    3178      I                   u1,
    3179      I                   v1,
    3180      I                   ftsol,
    3181      I                   pctsrf,
    3182      I                   rlat,
    3183      I                   frac_impa,
    3184      I                   frac_nucl,
    3185      I                   rlon,
    3186      I                   presnivs,
    3187      I                   pphis,
    3188      I                   pphi,
    3189      I                   albsol1,
    3190      I                   qx(1,1,1),
    3191      I                   rhcl,
    3192      I                   cldfra,
    3193      I                   rneb,
    3194      I                   diafra,
    3195      I                   cldliq,
    3196      I                   itop_con,
    3197      I                   ibas_con,
    3198      I                   pmflxr,
    3199      I                   pmflxs,
    3200      I                   prfl,
    3201      I                   psfl,
    3202      I                   da,
    3203      I                   phi,
    3204      I                   mp,
    3205      I                   upwd,
    3206      I                   dnwd,
    3207      I                   aerosol_couple,
    3208      I                   flxmass_w,
    3209      I                   tau_inca,
    3210      I                   piz_inca,
    3211      I                   cg_inca,
    3212      I                   ccm,
    3213      I                   rfname,
    3214      O                   tr_seri)
     3229
     3230      call phytrac (
     3231     I     itap,     days_elapsed+1,    jH_cur,   debut,
     3232     I     lafin,    dtime,     u, v,     t,
     3233     I     paprs,    pplay,     pmfu,     pmfd,
     3234     I     pen_u,    pde_u,     pen_d,    pde_d,
     3235     I     cdragh,   coefh,     fm_therm, entr_therm,
     3236     I     u1,       v1,        ftsol,    pctsrf,
     3237     I     rlat,     frac_impa, frac_nucl,rlon,
     3238     I     presnivs, pphis,     pphi,     albsol1,
     3239     I     qx(:,:,ivap),rhcl,   cldfra,   rneb,
     3240     I     diafra,   cldliq,    itop_con, ibas_con,
     3241     I     pmflxr,   pmflxs,    prfl,     psfl,
     3242     I     da,       phi,       mp,       upwd,     
     3243     I     dnwd,     aerosol_couple,      flxmass_w,
     3244     I     tau_aero, piz_aero,  cg_aero,  ccm,
     3245     I     rfname,
     3246     O     tr_seri)
    32153247
    32163248      IF (offline) THEN
    … …  
    32183250         print*,'Attention on met a 0 les thermiques pour phystoke'
    32193251         call phystokenc (
    3220      I                   nlon,nlev,pdtphys,rlon,rlat,
     3252     I                   nlon,klev,pdtphys,rlon,rlat,
    32213253     I                   t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
    32223254     I                   fm_therm,entr_therm,
    … …  
    32523284        d_t_ec(i,k)=0.5/ZRCPD
    32533285     $      *(u(i,k)**2+v(i,k)**2-u_seri(i,k)**2-v_seri(i,k)**2)
     3286      ENDDO
     3287      ENDDO
     3288
     3289      DO k = 1, klev
     3290      DO i = 1, klon
    32543291        t_seri(i,k)=t_seri(i,k)+d_t_ec(i,k)
    32553292        d_t_ec(i,k) = d_t_ec(i,k)/dtime
    … …  
    32673304C     est egale a la variation de la physique au pas de temps precedent.
    32683305C     Donc la somme de ces 2 variations devrait etre nulle.
     3306
    32693307        call diagphy(airephy,ztit,ip_ebil_phy
    32703308     e      , topsw, toplw, solsw, sollw, sens
    … …  
    33493387     $                        day_ini,
    33503388     $                        airephy,
    3351      $                        xjour,
    33523389     $                        pphi,
    33533390     $                        pphis,
    … …  
    34153452      write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
    34163453      write(lunout,*)
    3417      s 'nlon,nlev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys pct tlos'
     3454     s 'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos'
    34183455      write(lunout,*)
    3419      s  nlon,nlev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys,
     3456     s  nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur ,pdtphys,
    34203457     s  pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce),
    34213458     s  pctsrf(igout,is_sic)
    34223459      write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
    3423       do k=1,nlev
     3460      do k=1,klev
    34243461         write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k),
    34253462     s   d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k),
    … …  
    34273464      enddo
    34283465      write(lunout,*) 'cool,heat'
    3429       do k=1,nlev
     3466      do k=1,klev
    34303467         write(lunout,*) cool(igout,k),heat(igout,k)
    34313468      enddo
    34323469
    34333470      write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
    3434       do k=1,nlev
     3471      do k=1,klev
    34353472         write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k),
    34363473     s d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
    … …  
    34393476      write(lunout,*) 'd_ps ',d_ps(igout)
    34403477      write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
    3441       do k=1,nlev
     3478      do k=1,klev
    34423479         write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k),
    34433480     s  d_qx(igout,k,1),d_qx(igout,k,2)
    … …  
    35013538!         write(97) u_seri,v_seri,t_seri,q_seri
    35023539!         close(97)
     3540C$OMP MASTER
     3541         if (read_climoz >= 1) then
     3542            if (is_mpi_root) then
     3543               call nf95_close(ncid_climoz)
     3544            end if
     3545            deallocate(press_climoz) ! pointer
     3546         end if
     3547C$OMP END MASTER
    35033548      ENDIF
    35043549     
     3550!      first=.false.
    35053551
    35063552      RETURN

  • LMDZ4/trunk/libf/phylmd/plevel_new.F

    r1233 r1279  
    107107c     ...   Modif . P. Le Van    ( 20/01/98) ....
    108108c     Modif Frederic Hourdin (3/01/02)
    109                
     109
    110110               aist(i,nlev) = LOG( pgcm(i,lb(i,nlev))/ pres(nlev) )
    111111     &              / LOG( pgcm(i,lb(i,nlev))/ pgcm(i,lt(i,nlev)) )

  • LMDZ4/trunk/libf/phylmd/printflag.F

    r879 r1279  
    132132       PRINT 100
    133133
    134  4    FORMAT(2x,5(1H*),'  ok_journe= ',l3,3x,',ok_instan = ',
    135      , l3,3x,',ok_region = ',l3,3x,5(1H*) )
     134 4    FORMAT(2x,5("*"),'  ok_journe= ',l3,3x,',ok_instan = ',
     135     , l3,3x,',ok_region = ',l3,3x,5("*") )
    136136
    137  7     FORMAT(2x,5(1H*),15x,'      ok_limitvrai   = ',l3,16x,5(1h*) )
     137 7     FORMAT(2x,5("*"),15x,'      ok_limitvrai   = ',l3,16x,5("*") )
    138138
    139139 8     FORMAT(2x,'*****             radpas    =                      ' ,
    140140     , i4,6x,' *****')
    141141
    142  10    FORMAT(2x,5(1H*),'    Cycle_diurne = ',l3,4x,', Soil_model = ',
    143      , l3,12x,6(1H*) )
     142 10    FORMAT(2x,5("*"),'    Cycle_diurne = ',l3,4x,', Soil_model = ',
     143     , l3,12x,6("*") )
    144144
    145145
    146  11    FORMAT(2x,5(1H*),'  new_oliq = ',l3,3x,', Ok_orodr = ',
    147      , l3,3x,', Ok_orolf = ',l3,3x,5(1H*) )
     146 11    FORMAT(2x,5("*"),'  new_oliq = ',l3,3x,', Ok_orodr = ',
     147     , l3,3x,', Ok_orolf = ',l3,3x,5("*") )
    148148
    149149

  • LMDZ4/trunk/libf/phylmd/radepsi.h

    r524 r1279  
    22! $Header$
    33!
    4       REAL*8 ZEELOG, ZEPSC, ZEPSCO, ZEPSCQ, ZEPSCT, ZEPSCW
    5       REAL*8 ZEPSEC, ZEPSCR
     4      REAL(KIND=8) ZEELOG, ZEPSC, ZEPSCO, ZEPSCQ, ZEPSCT, ZEPSCW
     5      REAL(KIND=8) ZEPSEC, ZEPSCR
    66      PARAMETER (ZEELOG = 1.E-07) !1.e-10 (not good for 32-bit machines)
    77      PARAMETER (ZEPSC  = 1.E-20)
    … …  
    1313      PARAMETER (ZEPSCR = 1.0E-10)
    1414c
    15       REAL*8 REPSCT
     15      REAL(KIND=8) REPSCT
    1616      PARAMETER (REPSCT=1.0E-10)

  • LMDZ4/trunk/libf/phylmd/radiation_AR4.F

    r1107 r1279  
    5454C* ARGUMENTS:
    5555C
    56       REAL*8 PSCT  ! constante solaire (valeur conseillee: 1370)
    57 cIM ctes ds clesphys.h   REAL*8 RCO2  ! concentration CO2 (IPCC: 353.E-06*44.011/28.97)
     56      REAL(KIND=8) PSCT  ! constante solaire (valeur conseillee: 1370)
     57cIM ctes ds clesphys.h   REAL(KIND=8) RCO2  ! concentration CO2 (IPCC: 353.E-06*44.011/28.97)
    5858#include "clesphys.h"
    5959C
    60       REAL*8 PPSOL(KDLON)        ! SURFACE PRESSURE (PA)
    61       REAL*8 PDP(KDLON,KFLEV)    ! LAYER THICKNESS (PA)
    62       REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
    63 C
    64       REAL*8 PRMU0(KDLON)  ! COSINE OF ZENITHAL ANGLE
    65       REAL*8 PFRAC(KDLON)  ! fraction de la journee
    66 C
    67       REAL*8 PTAVE(KDLON,KFLEV)  ! LAYER TEMPERATURE (K)
    68       REAL*8 PWV(KDLON,KFLEV)    ! SPECIFIC HUMIDITY (KG/KG)
    69       REAL*8 PQS(KDLON,KFLEV)    ! SATURATED WATER VAPOUR (KG/KG)
    70       REAL*8 POZON(KDLON,KFLEV)  ! OZONE CONCENTRATION (KG/KG)
    71       REAL*8 PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS
    72 C
    73       REAL*8 PALBD(KDLON,2)  ! albedo du sol (lumiere diffuse)
    74       REAL*8 PALBP(KDLON,2)  ! albedo du sol (lumiere parallele)
    75 C
    76       REAL*8 PCLDSW(KDLON,KFLEV)    ! CLOUD FRACTION
    77       REAL*8 PTAU(KDLON,2,KFLEV)    ! CLOUD OPTICAL THICKNESS
    78       REAL*8 PCG(KDLON,2,KFLEV)     ! ASYMETRY FACTOR
    79       REAL*8 POMEGA(KDLON,2,KFLEV)  ! SINGLE SCATTERING ALBEDO
    80 C
    81       REAL*8 PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY)
    82       REAL*8 PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
    83       REAL*8 PALBPLA(KDLON)     ! PLANETARY ALBEDO
    84       REAL*8 PTOPSW(KDLON)      ! SHORTWAVE FLUX AT T.O.A.
    85       REAL*8 PSOLSW(KDLON)      ! SHORTWAVE FLUX AT SURFACE
    86       REAL*8 PTOPSW0(KDLON)     ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
    87       REAL*8 PSOLSW0(KDLON)     ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
     60      REAL(KIND=8) PPSOL(KDLON)        ! SURFACE PRESSURE (PA)
     61      REAL(KIND=8) PDP(KDLON,KFLEV)    ! LAYER THICKNESS (PA)
     62      REAL(KIND=8) PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
     63C
     64      REAL(KIND=8) PRMU0(KDLON)  ! COSINE OF ZENITHAL ANGLE
     65      REAL(KIND=8) PFRAC(KDLON)  ! fraction de la journee
     66C
     67      REAL(KIND=8) PTAVE(KDLON,KFLEV)  ! LAYER TEMPERATURE (K)
     68      REAL(KIND=8) PWV(KDLON,KFLEV)    ! SPECIFIC HUMIDITY (KG/KG)
     69      REAL(KIND=8) PQS(KDLON,KFLEV)    ! SATURATED WATER VAPOUR (KG/KG)
     70      REAL(KIND=8) POZON(KDLON,KFLEV)  ! OZONE CONCENTRATION (KG/KG)
     71      REAL(KIND=8) PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS
     72C
     73      REAL(KIND=8) PALBD(KDLON,2)  ! albedo du sol (lumiere diffuse)
     74      REAL(KIND=8) PALBP(KDLON,2)  ! albedo du sol (lumiere parallele)
     75C
     76      REAL(KIND=8) PCLDSW(KDLON,KFLEV)    ! CLOUD FRACTION
     77      REAL(KIND=8) PTAU(KDLON,2,KFLEV)    ! CLOUD OPTICAL THICKNESS
     78      REAL(KIND=8) PCG(KDLON,2,KFLEV)     ! ASYMETRY FACTOR
     79      REAL(KIND=8) POMEGA(KDLON,2,KFLEV)  ! SINGLE SCATTERING ALBEDO
     80C
     81      REAL(KIND=8) PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY)
     82      REAL(KIND=8) PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
     83      REAL(KIND=8) PALBPLA(KDLON)     ! PLANETARY ALBEDO
     84      REAL(KIND=8) PTOPSW(KDLON)      ! SHORTWAVE FLUX AT T.O.A.
     85      REAL(KIND=8) PSOLSW(KDLON)      ! SHORTWAVE FLUX AT SURFACE
     86      REAL(KIND=8) PTOPSW0(KDLON)     ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
     87      REAL(KIND=8) PSOLSW0(KDLON)     ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
    8888C
    8989C* LOCAL VARIABLES:
    9090C
    91       REAL*8 ZOZ(KDLON,KFLEV)
    92       REAL*8 ZAKI(KDLON,2)     
    93       REAL*8 ZCLD(KDLON,KFLEV)
    94       REAL*8 ZCLEAR(KDLON)
    95       REAL*8 ZDSIG(KDLON,KFLEV)
    96       REAL*8 ZFACT(KDLON)
    97       REAL*8 ZFD(KDLON,KFLEV+1)
    98       REAL*8 ZFDOWN(KDLON,KFLEV+1)
    99       REAL*8 ZFU(KDLON,KFLEV+1)
    100       REAL*8 ZFUP(KDLON,KFLEV+1)
    101       REAL*8 ZRMU(KDLON)
    102       REAL*8 ZSEC(KDLON)
    103       REAL*8 ZUD(KDLON,5,KFLEV+1)
    104       REAL*8 ZCLDSW0(KDLON,KFLEV)
     91      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
     92
     93      REAL(KIND=8) ZOZ(KDLON,KFLEV)
     94!     column-density of ozone in layer, in kilo-Dobsons
     95
     96      REAL(KIND=8) ZAKI(KDLON,2)     
     97      REAL(KIND=8) ZCLD(KDLON,KFLEV)
     98      REAL(KIND=8) ZCLEAR(KDLON)
     99      REAL(KIND=8) ZDSIG(KDLON,KFLEV)
     100      REAL(KIND=8) ZFACT(KDLON)
     101      REAL(KIND=8) ZFD(KDLON,KFLEV+1)
     102      REAL(KIND=8) ZFDOWN(KDLON,KFLEV+1)
     103      REAL(KIND=8) ZFU(KDLON,KFLEV+1)
     104      REAL(KIND=8) ZFUP(KDLON,KFLEV+1)
     105      REAL(KIND=8) ZRMU(KDLON)
     106      REAL(KIND=8) ZSEC(KDLON)
     107      REAL(KIND=8) ZUD(KDLON,5,KFLEV+1)
     108      REAL(KIND=8) ZCLDSW0(KDLON,KFLEV)
    105109c
    106       REAL*8 ZFSUP(KDLON,KFLEV+1)
    107       REAL*8 ZFSDN(KDLON,KFLEV+1)
    108       REAL*8 ZFSUP0(KDLON,KFLEV+1)
    109       REAL*8 ZFSDN0(KDLON,KFLEV+1)
     110      REAL(KIND=8) ZFSUP(KDLON,KFLEV+1)
     111      REAL(KIND=8) ZFSDN(KDLON,KFLEV+1)
     112      REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1)
     113      REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1)
    110114C
    111115      INTEGER inu, jl, jk, i, k, kpl1
    … …  
    122126c$OMP THREADPRIVATE(itapsw)
    123127cjq-Introduced for aerosol forcings
    124       real*8 flag_aer
     128      real(kind=8) flag_aer
    125129      logical ok_ade, ok_aie    ! use aerosol forcings or not?
    126       real*8 tauae(kdlon,kflev,2)  ! aerosol optical properties
    127       real*8 pizae(kdlon,kflev,2)  ! (see aeropt.F)
    128       real*8 cgae(kdlon,kflev,2)   ! -"-
    129       REAL*8 PTAUA(KDLON,2,KFLEV)    ! CLOUD OPTICAL THICKNESS (pre-industrial value)
    130       REAL*8 POMEGAA(KDLON,2,KFLEV)  ! SINGLE SCATTERING ALBEDO
    131       REAL*8 PTOPSWAD(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
    132       REAL*8 PSOLSWAD(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
    133       REAL*8 PTOPSWAI(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
    134       REAL*8 PSOLSWAI(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
     130      real(kind=8) tauae(kdlon,kflev,2)  ! aerosol optical properties
     131      real(kind=8) pizae(kdlon,kflev,2)  ! (see aeropt.F)
     132      real(kind=8) cgae(kdlon,kflev,2)   ! -"-
     133      REAL(KIND=8) PTAUA(KDLON,2,KFLEV)    ! CLOUD OPTICAL THICKNESS (pre-industrial value)
     134      REAL(KIND=8) POMEGAA(KDLON,2,KFLEV)  ! SINGLE SCATTERING ALBEDO
     135      REAL(KIND=8) PTOPSWAD(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
     136      REAL(KIND=8) PSOLSWAD(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
     137      REAL(KIND=8) PTOPSWAI(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
     138      REAL(KIND=8) PSOLSWAI(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
    135139cjq - Fluxes including aerosol effects
    136       REAL*8,allocatable,save :: ZFSUPAD(:,:)
     140      REAL(KIND=8),allocatable,save :: ZFSUPAD(:,:)
    137141c$OMP THREADPRIVATE(ZFSUPAD)
    138       REAL*8,allocatable,save :: ZFSDNAD(:,:)
     142      REAL(KIND=8),allocatable,save :: ZFSDNAD(:,:)
    139143c$OMP THREADPRIVATE(ZFSDNAD)
    140       REAL*8,allocatable,save :: ZFSUPAI(:,:)
     144      REAL(KIND=8),allocatable,save :: ZFSUPAI(:,:)
    141145c$OMP THREADPRIVATE(ZFSUPAI)
    142       REAL*8,allocatable,save :: ZFSDNAI(:,:)
     146      REAL(KIND=8),allocatable,save :: ZFSDNAI(:,:)
    143147c$OMP THREADPRIVATE(ZFSDNAI)
    144148      logical initialized
    … …  
    151155c$OMP THREADPRIVATE(initialized)
    152156cjq-end
     157      REAL tmp_
    153158      if(.not.initialized) then
    154159        flag_aer=0.
    … …  
    158163        allocate(ZFSUPAI(KDLON,KFLEV+1))
    159164        allocate(ZFSDNAI(KDLON,KFLEV+1))
    160         ZFSUPAD(:,:)=0.
    161         ZFSDNAD(:,:)=0.
    162         ZFSUPAI(:,:)=0.
    163         ZFSDNAI(:,:)=0.
    164        
     165        DO JK = 1 , KDLON*(KFLEV+1)
     166          ZFSUPAD(JK,1) = 0.0     ! ZFSUPAD(:,:)=0.
     167          ZFSDNAD(JK,1) = 0.0     ! ZFSDNAD(:,:)=0.
     168          ZFSUPAI(JK,1) = 0.0     ! ZFSUPAI(:,:)=0.
     169          ZFSDNAI(JK,1) = 0.0     ! ZFSDNAI(:,:)=0.
     170        END DO
    165171      endif
    166172!rv
    … …  
    175181      IF (MOD(itapsw,swpas).EQ.0) THEN
    176182c
     183      tmp_ = 1./( dobson_u * 1e3 * RG)
     184!cdir collapse
    177185      DO JK = 1 , KFLEV
    178       DO JL = 1, KDLON
    179          ZCLDSW0(JL,JK) = 0.0
    180          ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG
    181      .               *PDP(JL,JK)*(101325.0/PPSOL(JL))
    182       ENDDO
     186        DO JL = 1, KDLON
     187          ZCLDSW0(JL,JK) = 0.0
     188          ZOZ(JL,JK) = POZON(JL,JK)*tmp_*PDP(JL,JK)
     189        ENDDO
    183190      ENDDO
    184191C
    … …  
    339346     S                PRMU,PSEC,PUD)
    340347      USE dimphy
     348      USE radiation_AR4_param, only :
     349     S     ZPDH2O,ZPDUMG,ZPRH2O,ZPRUMG,RTDH2O,RTDUMG,RTH2O,RTUMG
    341350      IMPLICIT none
    342351cym#include "dimensions.h"
    … …  
    349358C* ARGUMENTS:
    350359C
    351       REAL*8 PSCT
    352 cIM ctes ds clesphys.h   REAL*8 RCO2
     360      REAL(KIND=8) PSCT
     361cIM ctes ds clesphys.h   REAL(KIND=8) RCO2
    353362#include "clesphys.h"
    354       REAL*8 PCLDSW(KDLON,KFLEV)
    355       REAL*8 PPMB(KDLON,KFLEV+1)
    356       REAL*8 PPSOL(KDLON)
    357       REAL*8 PRMU0(KDLON)
    358       REAL*8 PFRAC(KDLON)
    359       REAL*8 PTAVE(KDLON,KFLEV)
    360       REAL*8 PWV(KDLON,KFLEV)
    361 C
    362       REAL*8 PAKI(KDLON,2)
    363       REAL*8 PCLD(KDLON,KFLEV)
    364       REAL*8 PCLEAR(KDLON)
    365       REAL*8 PDSIG(KDLON,KFLEV)
    366       REAL*8 PFACT(KDLON)
    367       REAL*8 PRMU(KDLON)
    368       REAL*8 PSEC(KDLON)
    369       REAL*8 PUD(KDLON,5,KFLEV+1)
     363      REAL(KIND=8) PCLDSW(KDLON,KFLEV)
     364      REAL(KIND=8) PPMB(KDLON,KFLEV+1)
     365      REAL(KIND=8) PPSOL(KDLON)
     366      REAL(KIND=8) PRMU0(KDLON)
     367      REAL(KIND=8) PFRAC(KDLON)
     368      REAL(KIND=8) PTAVE(KDLON,KFLEV)
     369      REAL(KIND=8) PWV(KDLON,KFLEV)
     370C
     371      REAL(KIND=8) PAKI(KDLON,2)
     372      REAL(KIND=8) PCLD(KDLON,KFLEV)
     373      REAL(KIND=8) PCLEAR(KDLON)
     374      REAL(KIND=8) PDSIG(KDLON,KFLEV)
     375      REAL(KIND=8) PFACT(KDLON)
     376      REAL(KIND=8) PRMU(KDLON)
     377      REAL(KIND=8) PSEC(KDLON)
     378      REAL(KIND=8) PUD(KDLON,5,KFLEV+1)
    370379C
    371380C* LOCAL VARIABLES:
    372381C
    373382      INTEGER IIND(2)
    374       REAL*8 ZC1J(KDLON,KFLEV+1)
    375       REAL*8 ZCLEAR(KDLON)
    376       REAL*8 ZCLOUD(KDLON)
    377       REAL*8 ZN175(KDLON)
    378       REAL*8 ZN190(KDLON)
    379       REAL*8 ZO175(KDLON)
    380       REAL*8 ZO190(KDLON)
    381       REAL*8 ZSIGN(KDLON)
    382       REAL*8 ZR(KDLON,2)
    383       REAL*8 ZSIGO(KDLON)
    384       REAL*8 ZUD(KDLON,2)
    385       REAL*8 ZRTH, ZRTU, ZWH2O, ZDSCO2, ZDSH2O, ZFPPW
     383      REAL(KIND=8) ZC1J(KDLON,KFLEV+1)
     384      REAL(KIND=8) ZCLEAR(KDLON)
     385      REAL(KIND=8) ZCLOUD(KDLON)
     386      REAL(KIND=8) ZN175(KDLON)
     387      REAL(KIND=8) ZN190(KDLON)
     388      REAL(KIND=8) ZO175(KDLON)
     389      REAL(KIND=8) ZO190(KDLON)
     390      REAL(KIND=8) ZSIGN(KDLON)
     391      REAL(KIND=8) ZR(KDLON,2)
     392      REAL(KIND=8) ZSIGO(KDLON)
     393      REAL(KIND=8) ZUD(KDLON,2)
     394      REAL(KIND=8) ZRTH, ZRTU, ZWH2O, ZDSCO2, ZDSH2O, ZFPPW
    386395      INTEGER jl, jk, jkp1, jkl, jklp1, ja
    387396C
    388 C* Prescribed Data:
    389 c
    390       REAL*8 ZPDH2O,ZPDUMG
    391       SAVE ZPDH2O,ZPDUMG
    392 c$OMP THREADPRIVATE(ZPDH2O,ZPDUMG)
    393       REAL*8 ZPRH2O,ZPRUMG
    394       SAVE ZPRH2O,ZPRUMG
    395 c$OMP THREADPRIVATE(ZPRH2O,ZPRUMG)
    396       REAL*8 RTDH2O,RTDUMG
    397       SAVE RTDH2O,RTDUMG
    398 c$OMP THREADPRIVATE(RTDH2O,RTDUMG)
    399       REAL*8 RTH2O ,RTUMG
    400       SAVE RTH2O ,RTUMG
    401 c$OMP THREADPRIVATE(RTH2O ,RTUMG)
    402       DATA ZPDH2O,ZPDUMG / 0.8   , 0.75 /
    403       DATA ZPRH2O,ZPRUMG / 30000., 30000. /
    404       DATA RTDH2O,RTDUMG /  0.40  , 0.375 /
    405       DATA RTH2O ,RTUMG  /  240.  , 240.  /
    406397C     ------------------------------------------------------------------
    407398C
    … …  
    534525     S  ,  PFD   , PFU)
    535526      USE dimphy
     527      USE radiation_AR4_param, only : RSUN, RRAY
    536528      IMPLICIT none
    537529cym#include "dimensions.h"
    … …  
    573565      INTEGER KNU
    574566c-OB
    575       real*8 flag_aer
    576       real*8 tauae(kdlon,kflev,2)
    577       real*8 pizae(kdlon,kflev,2)
    578       real*8 cgae(kdlon,kflev,2)
    579       REAL*8 PAER(KDLON,KFLEV,5)
    580       REAL*8 PALBD(KDLON,2)
    581       REAL*8 PALBP(KDLON,2)
    582       REAL*8 PCG(KDLON,2,KFLEV) 
    583       REAL*8 PCLD(KDLON,KFLEV)
    584       REAL*8 PCLDSW(KDLON,KFLEV)
    585       REAL*8 PCLEAR(KDLON)
    586       REAL*8 PDSIG(KDLON,KFLEV)
    587       REAL*8 POMEGA(KDLON,2,KFLEV)
    588       REAL*8 POZ(KDLON,KFLEV)
    589       REAL*8 PRMU(KDLON)
    590       REAL*8 PSEC(KDLON)
    591       REAL*8 PTAU(KDLON,2,KFLEV)
    592       REAL*8 PUD(KDLON,5,KFLEV+1)
    593 C
    594       REAL*8 PFD(KDLON,KFLEV+1)
    595       REAL*8 PFU(KDLON,KFLEV+1)
     567      real(kind=8) flag_aer
     568      real(kind=8) tauae(kdlon,kflev,2)
     569      real(kind=8) pizae(kdlon,kflev,2)
     570      real(kind=8) cgae(kdlon,kflev,2)
     571      REAL(KIND=8) PAER(KDLON,KFLEV,5)
     572      REAL(KIND=8) PALBD(KDLON,2)
     573      REAL(KIND=8) PALBP(KDLON,2)
     574      REAL(KIND=8) PCG(KDLON,2,KFLEV) 
     575      REAL(KIND=8) PCLD(KDLON,KFLEV)
     576      REAL(KIND=8) PCLDSW(KDLON,KFLEV)
     577      REAL(KIND=8) PCLEAR(KDLON)
     578      REAL(KIND=8) PDSIG(KDLON,KFLEV)
     579      REAL(KIND=8) POMEGA(KDLON,2,KFLEV)
     580      REAL(KIND=8) POZ(KDLON,KFLEV)
     581      REAL(KIND=8) PRMU(KDLON)
     582      REAL(KIND=8) PSEC(KDLON)
     583      REAL(KIND=8) PTAU(KDLON,2,KFLEV)
     584      REAL(KIND=8) PUD(KDLON,5,KFLEV+1)
     585C
     586      REAL(KIND=8) PFD(KDLON,KFLEV+1)
     587      REAL(KIND=8) PFU(KDLON,KFLEV+1)
    596588C
    597589C* LOCAL VARIABLES:
    … …  
    599591      INTEGER IIND(4)
    600592C     
    601       REAL*8 ZCGAZ(KDLON,KFLEV)
    602       REAL*8 ZDIFF(KDLON)
    603       REAL*8 ZDIRF(KDLON)       
    604       REAL*8 ZPIZAZ(KDLON,KFLEV)
    605       REAL*8 ZRAYL(KDLON)
    606       REAL*8 ZRAY1(KDLON,KFLEV+1)
    607       REAL*8 ZRAY2(KDLON,KFLEV+1)
    608       REAL*8 ZREFZ(KDLON,2,KFLEV+1)
    609       REAL*8 ZRJ(KDLON,6,KFLEV+1)
    610       REAL*8 ZRJ0(KDLON,6,KFLEV+1)
    611       REAL*8 ZRK(KDLON,6,KFLEV+1)
    612       REAL*8 ZRK0(KDLON,6,KFLEV+1)
    613       REAL*8 ZRMUE(KDLON,KFLEV+1)
    614       REAL*8 ZRMU0(KDLON,KFLEV+1)
    615       REAL*8 ZR(KDLON,4)
    616       REAL*8 ZTAUAZ(KDLON,KFLEV)
    617       REAL*8 ZTRA1(KDLON,KFLEV+1)
    618       REAL*8 ZTRA2(KDLON,KFLEV+1)
    619       REAL*8 ZW(KDLON,4)
     593      REAL(KIND=8) ZCGAZ(KDLON,KFLEV)
     594      REAL(KIND=8) ZDIFF(KDLON)
     595      REAL(KIND=8) ZDIRF(KDLON)       
     596      REAL(KIND=8) ZPIZAZ(KDLON,KFLEV)
     597      REAL(KIND=8) ZRAYL(KDLON)
     598      REAL(KIND=8) ZRAY1(KDLON,KFLEV+1)
     599      REAL(KIND=8) ZRAY2(KDLON,KFLEV+1)
     600      REAL(KIND=8) ZREFZ(KDLON,2,KFLEV+1)
     601      REAL(KIND=8) ZRJ(KDLON,6,KFLEV+1)
     602      REAL(KIND=8) ZRJ0(KDLON,6,KFLEV+1)
     603      REAL(KIND=8) ZRK(KDLON,6,KFLEV+1)
     604      REAL(KIND=8) ZRK0(KDLON,6,KFLEV+1)
     605      REAL(KIND=8) ZRMUE(KDLON,KFLEV+1)
     606      REAL(KIND=8) ZRMU0(KDLON,KFLEV+1)
     607      REAL(KIND=8) ZR(KDLON,4)
     608      REAL(KIND=8) ZTAUAZ(KDLON,KFLEV)
     609      REAL(KIND=8) ZTRA1(KDLON,KFLEV+1)
     610      REAL(KIND=8) ZTRA2(KDLON,KFLEV+1)
     611      REAL(KIND=8) ZW(KDLON,4)
    620612C
    621613      INTEGER jl, jk, k, jaj, ikm1, ikl
    622 c
    623 c Prescribed Data:
    624 c
    625       REAL*8 RSUN(2)
    626       SAVE RSUN
    627 c$OMP THREADPRIVATE(RSUN)
    628       REAL*8 RRAY(2,6)
    629       SAVE RRAY
    630 c$OMP THREADPRIVATE(RRAY)
    631       DATA RSUN(1) / 0.441676 /
    632       DATA RSUN(2) / 0.558324 /
    633       DATA (RRAY(1,K),K=1,6) /
    634      S .428937E-01, .890743E+00,-.288555E+01,
    635      S .522744E+01,-.469173E+01, .161645E+01/
    636       DATA (RRAY(2,K),K=1,6) /
    637      S .697200E-02, .173297E-01,-.850903E-01,
    638      S .248261E+00,-.302031E+00, .129662E+00/
     614
    639615C     ------------------------------------------------------------------
    640616C
    … …  
    777753     S  ,  PFDOWN,PFUP                                            )
    778754      USE dimphy
     755      USE radiation_AR4_param, only : RSUN, RRAY
    779756      IMPLICIT none
    780757cym#include "dimensions.h"
    … …  
    821798      INTEGER KNU
    822799c-OB
    823       real*8 flag_aer
    824       real*8 tauae(kdlon,kflev,2)
    825       real*8 pizae(kdlon,kflev,2)
    826       real*8 cgae(kdlon,kflev,2)
    827       REAL*8 PAER(KDLON,KFLEV,5)
    828       REAL*8 PAKI(KDLON,2)
    829       REAL*8 PALBD(KDLON,2)
    830       REAL*8 PALBP(KDLON,2)
    831       REAL*8 PCG(KDLON,2,KFLEV)
    832       REAL*8 PCLD(KDLON,KFLEV)
    833       REAL*8 PCLDSW(KDLON,KFLEV)
    834       REAL*8 PCLEAR(KDLON)
    835       REAL*8 PDSIG(KDLON,KFLEV)
    836       REAL*8 POMEGA(KDLON,2,KFLEV)
    837       REAL*8 POZ(KDLON,KFLEV)
    838       REAL*8 PQS(KDLON,KFLEV)
    839       REAL*8 PRMU(KDLON)
    840       REAL*8 PSEC(KDLON)
    841       REAL*8 PTAU(KDLON,2,KFLEV)
    842       REAL*8 PUD(KDLON,5,KFLEV+1)
    843       REAL*8 PWV(KDLON,KFLEV)
    844 C
    845       REAL*8 PFDOWN(KDLON,KFLEV+1)
    846       REAL*8 PFUP(KDLON,KFLEV+1)
     800      real(kind=8) flag_aer
     801      real(kind=8) tauae(kdlon,kflev,2)
     802      real(kind=8) pizae(kdlon,kflev,2)
     803      real(kind=8) cgae(kdlon,kflev,2)
     804      REAL(KIND=8) PAER(KDLON,KFLEV,5)
     805      REAL(KIND=8) PAKI(KDLON,2)
     806      REAL(KIND=8) PALBD(KDLON,2)
     807      REAL(KIND=8) PALBP(KDLON,2)
     808      REAL(KIND=8) PCG(KDLON,2,KFLEV)
     809      REAL(KIND=8) PCLD(KDLON,KFLEV)
     810      REAL(KIND=8) PCLDSW(KDLON,KFLEV)
     811      REAL(KIND=8) PCLEAR(KDLON)
     812      REAL(KIND=8) PDSIG(KDLON,KFLEV)
     813      REAL(KIND=8) POMEGA(KDLON,2,KFLEV)
     814      REAL(KIND=8) POZ(KDLON,KFLEV)
     815      REAL(KIND=8) PQS(KDLON,KFLEV)
     816      REAL(KIND=8) PRMU(KDLON)
     817      REAL(KIND=8) PSEC(KDLON)
     818      REAL(KIND=8) PTAU(KDLON,2,KFLEV)
     819      REAL(KIND=8) PUD(KDLON,5,KFLEV+1)
     820      REAL(KIND=8) PWV(KDLON,KFLEV)
     821C
     822      REAL(KIND=8) PFDOWN(KDLON,KFLEV+1)
     823      REAL(KIND=8) PFUP(KDLON,KFLEV+1)
    847824C
    848825C* LOCAL VARIABLES:
    849826C
    850827      INTEGER IIND2(2), IIND3(3)
    851       REAL*8 ZCGAZ(KDLON,KFLEV)
    852       REAL*8 ZFD(KDLON,KFLEV+1)
    853       REAL*8 ZFU(KDLON,KFLEV+1)
    854       REAL*8 ZG(KDLON)
    855       REAL*8 ZGG(KDLON)
    856       REAL*8 ZPIZAZ(KDLON,KFLEV)
    857       REAL*8 ZRAYL(KDLON)
    858       REAL*8 ZRAY1(KDLON,KFLEV+1)
    859       REAL*8 ZRAY2(KDLON,KFLEV+1)
    860       REAL*8 ZREF(KDLON)
    861       REAL*8 ZREFZ(KDLON,2,KFLEV+1)
    862       REAL*8 ZRE1(KDLON)
    863       REAL*8 ZRE2(KDLON)
    864       REAL*8 ZRJ(KDLON,6,KFLEV+1)
    865       REAL*8 ZRJ0(KDLON,6,KFLEV+1)
    866       REAL*8 ZRK(KDLON,6,KFLEV+1)
    867       REAL*8 ZRK0(KDLON,6,KFLEV+1)
    868       REAL*8 ZRL(KDLON,8)
    869       REAL*8 ZRMUE(KDLON,KFLEV+1)
    870       REAL*8 ZRMU0(KDLON,KFLEV+1)
    871       REAL*8 ZRMUZ(KDLON)
    872       REAL*8 ZRNEB(KDLON)
    873       REAL*8 ZRUEF(KDLON,8)
    874       REAL*8 ZR1(KDLON)
    875       REAL*8 ZR2(KDLON,2)
    876       REAL*8 ZR3(KDLON,3)
    877       REAL*8 ZR4(KDLON)
    878       REAL*8 ZR21(KDLON)
    879       REAL*8 ZR22(KDLON)
    880       REAL*8 ZS(KDLON)
    881       REAL*8 ZTAUAZ(KDLON,KFLEV)
    882       REAL*8 ZTO1(KDLON)
    883       REAL*8 ZTR(KDLON,2,KFLEV+1)
    884       REAL*8 ZTRA1(KDLON,KFLEV+1)
    885       REAL*8 ZTRA2(KDLON,KFLEV+1)
    886       REAL*8 ZTR1(KDLON)
    887       REAL*8 ZTR2(KDLON)
    888       REAL*8 ZW(KDLON)   
    889       REAL*8 ZW1(KDLON)
    890       REAL*8 ZW2(KDLON,2)
    891       REAL*8 ZW3(KDLON,3)
    892       REAL*8 ZW4(KDLON)
    893       REAL*8 ZW5(KDLON)
     828      REAL(KIND=8) ZCGAZ(KDLON,KFLEV)
     829      REAL(KIND=8) ZFD(KDLON,KFLEV+1)
     830      REAL(KIND=8) ZFU(KDLON,KFLEV+1)
     831      REAL(KIND=8) ZG(KDLON)
     832      REAL(KIND=8) ZGG(KDLON)
     833      REAL(KIND=8) ZPIZAZ(KDLON,KFLEV)
     834      REAL(KIND=8) ZRAYL(KDLON)
     835      REAL(KIND=8) ZRAY1(KDLON,KFLEV+1)
     836      REAL(KIND=8) ZRAY2(KDLON,KFLEV+1)
     837      REAL(KIND=8) ZREF(KDLON)
     838      REAL(KIND=8) ZREFZ(KDLON,2,KFLEV+1)
     839      REAL(KIND=8) ZRE1(KDLON)
     840      REAL(KIND=8) ZRE2(KDLON)
     841      REAL(KIND=8) ZRJ(KDLON,6,KFLEV+1)
     842      REAL(KIND=8) ZRJ0(KDLON,6,KFLEV+1)
     843      REAL(KIND=8) ZRK(KDLON,6,KFLEV+1)
     844      REAL(KIND=8) ZRK0(KDLON,6,KFLEV+1)
     845      REAL(KIND=8) ZRL(KDLON,8)
     846      REAL(KIND=8) ZRMUE(KDLON,KFLEV+1)
     847      REAL(KIND=8) ZRMU0(KDLON,KFLEV+1)
     848      REAL(KIND=8) ZRMUZ(KDLON)
     849      REAL(KIND=8) ZRNEB(KDLON)
     850      REAL(KIND=8) ZRUEF(KDLON,8)
     851      REAL(KIND=8) ZR1(KDLON)
     852      REAL(KIND=8) ZR2(KDLON,2)
     853      REAL(KIND=8) ZR3(KDLON,3)
     854      REAL(KIND=8) ZR4(KDLON)
     855      REAL(KIND=8) ZR21(KDLON)
     856      REAL(KIND=8) ZR22(KDLON)
     857      REAL(KIND=8) ZS(KDLON)
     858      REAL(KIND=8) ZTAUAZ(KDLON,KFLEV)
     859      REAL(KIND=8) ZTO1(KDLON)
     860      REAL(KIND=8) ZTR(KDLON,2,KFLEV+1)
     861      REAL(KIND=8) ZTRA1(KDLON,KFLEV+1)
     862      REAL(KIND=8) ZTRA2(KDLON,KFLEV+1)
     863      REAL(KIND=8) ZTR1(KDLON)
     864      REAL(KIND=8) ZTR2(KDLON)
     865      REAL(KIND=8) ZW(KDLON)   
     866      REAL(KIND=8) ZW1(KDLON)
     867      REAL(KIND=8) ZW2(KDLON,2)
     868      REAL(KIND=8) ZW3(KDLON,3)
     869      REAL(KIND=8) ZW4(KDLON)
     870      REAL(KIND=8) ZW5(KDLON)
    894871C
    895872      INTEGER jl, jk, k, jaj, ikm1, ikl, jn, jabs, jkm1
    896873      INTEGER jref, jkl, jklp1, jajp, jkki, jkkp4, jn2j, iabs
    897       REAL*8 ZRMUM1, ZWH2O, ZCNEB, ZAA, ZBB, ZRKI, ZRE11
    898 C
    899 C* Prescribed Data:
    900 C
    901       REAL*8 RSUN(2)
    902       SAVE RSUN
    903 c$OMP THREADPRIVATE(RSUN)
    904       REAL*8 RRAY(2,6)
    905       SAVE RRAY
    906 c$OMP THREADPRIVATE(RRAY)
    907       DATA RSUN(1) / 0.441676 /
    908       DATA RSUN(2) / 0.558324 /
    909       DATA (RRAY(1,K),K=1,6) /
    910      S .428937E-01, .890743E+00,-.288555E+01,
    911      S .522744E+01,-.469173E+01, .161645E+01/
    912       DATA (RRAY(2,K),K=1,6) /
    913      S .697200E-02, .173297E-01,-.850903E-01,
    914      S .248261E+00,-.302031E+00, .129662E+00/
     874      REAL(KIND=8) ZRMUM1, ZWH2O, ZCNEB, ZAA, ZBB, ZRKI, ZRE11
     875C
     876
    915877C
    916878C     ------------------------------------------------------------------
    … …  
    13261288     S  , PRK   , PRMU0 , PTAUAZ, PTRA1 , PTRA2                   )
    13271289      USE dimphy
     1290      USE radiation_AR4_param, only : TAUA, RPIZA, RCGA
    13281291      IMPLICIT none
    13291292cym#include "dimensions.h"
    … …  
    13571320      INTEGER KNU
    13581321c-OB
    1359       real*8 flag_aer
    1360       real*8 tauae(kdlon,kflev,2)
    1361       real*8 pizae(kdlon,kflev,2)
    1362       real*8 cgae(kdlon,kflev,2)
    1363       REAL*8 PAER(KDLON,KFLEV,5)
    1364       REAL*8 PALBP(KDLON,2)
    1365       REAL*8 PDSIG(KDLON,KFLEV)
    1366       REAL*8 PRAYL(KDLON)
    1367       REAL*8 PSEC(KDLON)
    1368 C
    1369       REAL*8 PCGAZ(KDLON,KFLEV)     
    1370       REAL*8 PPIZAZ(KDLON,KFLEV)
    1371       REAL*8 PRAY1(KDLON,KFLEV+1)
    1372       REAL*8 PRAY2(KDLON,KFLEV+1)
    1373       REAL*8 PREFZ(KDLON,2,KFLEV+1)
    1374       REAL*8 PRJ(KDLON,6,KFLEV+1)
    1375       REAL*8 PRK(KDLON,6,KFLEV+1)
    1376       REAL*8 PRMU0(KDLON,KFLEV+1)
    1377       REAL*8 PTAUAZ(KDLON,KFLEV)
    1378       REAL*8 PTRA1(KDLON,KFLEV+1)
    1379       REAL*8 PTRA2(KDLON,KFLEV+1)
     1322      real(kind=8) flag_aer
     1323      real(kind=8) tauae(kdlon,kflev,2)
     1324      real(kind=8) pizae(kdlon,kflev,2)
     1325      real(kind=8) cgae(kdlon,kflev,2)
     1326      REAL(KIND=8) PAER(KDLON,KFLEV,5)
     1327      REAL(KIND=8) PALBP(KDLON,2)
     1328      REAL(KIND=8) PDSIG(KDLON,KFLEV)
     1329      REAL(KIND=8) PRAYL(KDLON)
     1330      REAL(KIND=8) PSEC(KDLON)
     1331C
     1332      REAL(KIND=8) PCGAZ(KDLON,KFLEV)     
     1333      REAL(KIND=8) PPIZAZ(KDLON,KFLEV)
     1334      REAL(KIND=8) PRAY1(KDLON,KFLEV+1)
     1335      REAL(KIND=8) PRAY2(KDLON,KFLEV+1)
     1336      REAL(KIND=8) PREFZ(KDLON,2,KFLEV+1)
     1337      REAL(KIND=8) PRJ(KDLON,6,KFLEV+1)
     1338      REAL(KIND=8) PRK(KDLON,6,KFLEV+1)
     1339      REAL(KIND=8) PRMU0(KDLON,KFLEV+1)
     1340      REAL(KIND=8) PTAUAZ(KDLON,KFLEV)
     1341      REAL(KIND=8) PTRA1(KDLON,KFLEV+1)
     1342      REAL(KIND=8) PTRA2(KDLON,KFLEV+1)
    13801343C
    13811344C* LOCAL VARIABLES:
    13821345C
    1383       REAL*8 ZC0I(KDLON,KFLEV+1)       
    1384       REAL*8 ZCLE0(KDLON,KFLEV)
    1385       REAL*8 ZCLEAR(KDLON)
    1386       REAL*8 ZR21(KDLON)
    1387       REAL*8 ZR23(KDLON)
    1388       REAL*8 ZSS0(KDLON)
    1389       REAL*8 ZSCAT(KDLON)
    1390       REAL*8 ZTR(KDLON,2,KFLEV+1)
     1346      REAL(KIND=8) ZC0I(KDLON,KFLEV+1)       
     1347      REAL(KIND=8) ZCLE0(KDLON,KFLEV)
     1348      REAL(KIND=8) ZCLEAR(KDLON)
     1349      REAL(KIND=8) ZR21(KDLON)
     1350      REAL(KIND=8) ZR23(KDLON)
     1351      REAL(KIND=8) ZSS0(KDLON)
     1352      REAL(KIND=8) ZSCAT(KDLON)
     1353      REAL(KIND=8) ZTR(KDLON,2,KFLEV+1)
    13911354C
    13921355      INTEGER jl, jk, ja, jae, jkl, jklp1, jaj, jkm1, in
    1393       REAL*8 ZTRAY, ZGAR, ZRATIO, ZFF, ZFACOA, ZCORAE
    1394       REAL*8 ZMUE, ZGAP, ZWW, ZTO, ZDEN, ZMU1, ZDEN1
    1395       REAL*8 ZBMU0, ZBMU1, ZRE11
    1396 C
    1397 C* Prescribed Data for Aerosols:
    1398 C
    1399       REAL*8 TAUA(2,5), RPIZA(2,5), RCGA(2,5)
    1400       SAVE TAUA, RPIZA, RCGA
    1401 c$OMP THREADPRIVATE(TAUA, RPIZA, RCGA)
    1402       DATA ((TAUA(IN,JA),JA=1,5),IN=1,2) /
    1403      S .730719, .912819, .725059, .745405, .682188 ,
    1404      S .730719, .912819, .725059, .745405, .682188 /
    1405       DATA ((RPIZA(IN,JA),JA=1,5),IN=1,2) /
    1406      S .872212, .982545, .623143, .944887, .997975 ,
    1407      S .872212, .982545, .623143, .944887, .997975 /
    1408       DATA ((RCGA (IN,JA),JA=1,5),IN=1,2) /
    1409      S .647596, .739002, .580845, .662657, .624246 ,
    1410      S .647596, .739002, .580845, .662657, .624246 /
     1356      REAL(KIND=8) ZTRAY, ZGAR, ZRATIO, ZFF, ZFACOA, ZCORAE
     1357      REAL(KIND=8) ZMUE, ZGAP, ZWW, ZTO, ZDEN, ZMU1, ZDEN1
     1358      REAL(KIND=8) ZBMU0, ZBMU1, ZRE11
     1359C
     1360
    14111361C     ------------------------------------------------------------------
    14121362C
    … …  
    14161366 100  CONTINUE
    14171367C
     1368!cdir collapse
    14181369      DO 103 JK = 1 , KFLEV+1
    14191370      DO 102 JA = 1 , 6
    … …  
    17241675C
    17251676      INTEGER KNU
    1726       REAL*8 PALBD(KDLON,2)
    1727       REAL*8 PCG(KDLON,2,KFLEV)
    1728       REAL*8 PCLD(KDLON,KFLEV)
    1729       REAL*8 PDSIG(KDLON,KFLEV)
    1730       REAL*8 POMEGA(KDLON,2,KFLEV)
    1731       REAL*8 PRAYL(KDLON)
    1732       REAL*8 PSEC(KDLON)
    1733       REAL*8 PTAU(KDLON,2,KFLEV)
    1734 C
    1735       REAL*8 PRAY1(KDLON,KFLEV+1)
    1736       REAL*8 PRAY2(KDLON,KFLEV+1)
    1737       REAL*8 PREFZ(KDLON,2,KFLEV+1)
    1738       REAL*8 PRJ(KDLON,6,KFLEV+1)
    1739       REAL*8 PRK(KDLON,6,KFLEV+1)
    1740       REAL*8 PRMUE(KDLON,KFLEV+1)
    1741       REAL*8 PCGAZ(KDLON,KFLEV)
    1742       REAL*8 PPIZAZ(KDLON,KFLEV)
    1743       REAL*8 PTAUAZ(KDLON,KFLEV)
    1744       REAL*8 PTRA1(KDLON,KFLEV+1)
    1745       REAL*8 PTRA2(KDLON,KFLEV+1)
     1677      REAL(KIND=8) PALBD(KDLON,2)
     1678      REAL(KIND=8) PCG(KDLON,2,KFLEV)
     1679      REAL(KIND=8) PCLD(KDLON,KFLEV)
     1680      REAL(KIND=8) PDSIG(KDLON,KFLEV)
     1681      REAL(KIND=8) POMEGA(KDLON,2,KFLEV)
     1682      REAL(KIND=8) PRAYL(KDLON)
     1683      REAL(KIND=8) PSEC(KDLON)
     1684      REAL(KIND=8) PTAU(KDLON,2,KFLEV)
     1685C
     1686      REAL(KIND=8) PRAY1(KDLON,KFLEV+1)
     1687      REAL(KIND=8) PRAY2(KDLON,KFLEV+1)
     1688      REAL(KIND=8) PREFZ(KDLON,2,KFLEV+1)
     1689      REAL(KIND=8) PRJ(KDLON,6,KFLEV+1)
     1690      REAL(KIND=8) PRK(KDLON,6,KFLEV+1)
     1691      REAL(KIND=8) PRMUE(KDLON,KFLEV+1)
     1692      REAL(KIND=8) PCGAZ(KDLON,KFLEV)
     1693      REAL(KIND=8) PPIZAZ(KDLON,KFLEV)
     1694      REAL(KIND=8) PTAUAZ(KDLON,KFLEV)
     1695      REAL(KIND=8) PTRA1(KDLON,KFLEV+1)
     1696      REAL(KIND=8) PTRA2(KDLON,KFLEV+1)
    17461697C
    17471698C* LOCAL VARIABLES:
    17481699C
    1749       REAL*8 ZC1I(KDLON,KFLEV+1)
    1750       REAL*8 ZCLEQ(KDLON,KFLEV)
    1751       REAL*8 ZCLEAR(KDLON)
    1752       REAL*8 ZCLOUD(KDLON)
    1753       REAL*8 ZGG(KDLON)
    1754       REAL*8 ZREF(KDLON)
    1755       REAL*8 ZRE1(KDLON)
    1756       REAL*8 ZRE2(KDLON)
    1757       REAL*8 ZRMUZ(KDLON)
    1758       REAL*8 ZRNEB(KDLON)
    1759       REAL*8 ZR21(KDLON)
    1760       REAL*8 ZR22(KDLON)
    1761       REAL*8 ZR23(KDLON)
    1762       REAL*8 ZSS1(KDLON)
    1763       REAL*8 ZTO1(KDLON)
    1764       REAL*8 ZTR(KDLON,2,KFLEV+1)
    1765       REAL*8 ZTR1(KDLON)
    1766       REAL*8 ZTR2(KDLON)
    1767       REAL*8 ZW(KDLON)
     1700      REAL(KIND=8) ZC1I(KDLON,KFLEV+1)
     1701      REAL(KIND=8) ZCLEQ(KDLON,KFLEV)
     1702      REAL(KIND=8) ZCLEAR(KDLON)
     1703      REAL(KIND=8) ZCLOUD(KDLON)
     1704      REAL(KIND=8) ZGG(KDLON)
     1705      REAL(KIND=8) ZREF(KDLON)
     1706      REAL(KIND=8) ZRE1(KDLON)
     1707      REAL(KIND=8) ZRE2(KDLON)
     1708      REAL(KIND=8) ZRMUZ(KDLON)
     1709      REAL(KIND=8) ZRNEB(KDLON)
     1710      REAL(KIND=8) ZR21(KDLON)
     1711      REAL(KIND=8) ZR22(KDLON)
     1712      REAL(KIND=8) ZR23(KDLON)
     1713      REAL(KIND=8) ZSS1(KDLON)
     1714      REAL(KIND=8) ZTO1(KDLON)
     1715      REAL(KIND=8) ZTR(KDLON,2,KFLEV+1)
     1716      REAL(KIND=8) ZTR1(KDLON)
     1717      REAL(KIND=8) ZTR2(KDLON)
     1718      REAL(KIND=8) ZW(KDLON)
    17681719C
    17691720      INTEGER jk, jl, ja, jkl, jklp1, jkm1, jaj
    1770       REAL*8 ZFACOA, ZFACOC, ZCORAE, ZCORCD
    1771       REAL*8 ZMUE, ZGAP, ZWW, ZTO, ZDEN, ZDEN1
    1772       REAL*8 ZMU1, ZRE11, ZBMU0, ZBMU1
     1721      REAL(KIND=8) ZFACOA, ZFACOC, ZCORAE, ZCORCD
     1722      REAL(KIND=8) ZMUE, ZGAP, ZWW, ZTO, ZDEN, ZDEN1
     1723      REAL(KIND=8) ZMU1, ZRE11, ZBMU0, ZBMU1
    17731724C
    17741725C     ------------------------------------------------------------------
    … …  
    20772028C* ARGUMENTS:
    20782029C
    2079       REAL*8 PGG(KDLON)   ! ASSYMETRY FACTOR
    2080       REAL*8 PREF(KDLON)  ! REFLECTIVITY OF THE UNDERLYING LAYER
    2081       REAL*8 PRMUZ(KDLON) ! COSINE OF SOLAR ZENITH ANGLE
    2082       REAL*8 PTO1(KDLON)  ! OPTICAL THICKNESS
    2083       REAL*8 PW(KDLON)    ! SINGLE SCATTERING ALBEDO
    2084       REAL*8 PRE1(KDLON)  ! LAYER REFLECTIVITY (NO UNDERLYING-LAYER REFLECTION)
    2085       REAL*8 PRE2(KDLON)  ! LAYER REFLECTIVITY
    2086       REAL*8 PTR1(KDLON)  ! LAYER TRANSMISSIVITY (NO UNDERLYING-LAYER REFLECTION)
    2087       REAL*8 PTR2(KDLON)  ! LAYER TRANSMISSIVITY
     2030      REAL(KIND=8) PGG(KDLON)   ! ASSYMETRY FACTOR
     2031      REAL(KIND=8) PREF(KDLON)  ! REFLECTIVITY OF THE UNDERLYING LAYER
     2032      REAL(KIND=8) PRMUZ(KDLON) ! COSINE OF SOLAR ZENITH ANGLE
     2033      REAL(KIND=8) PTO1(KDLON)  ! OPTICAL THICKNESS
     2034      REAL(KIND=8) PW(KDLON)    ! SINGLE SCATTERING ALBEDO
     2035      REAL(KIND=8) PRE1(KDLON)  ! LAYER REFLECTIVITY (NO UNDERLYING-LAYER REFLECTION)
     2036      REAL(KIND=8) PRE2(KDLON)  ! LAYER REFLECTIVITY
     2037      REAL(KIND=8) PTR1(KDLON)  ! LAYER TRANSMISSIVITY (NO UNDERLYING-LAYER REFLECTION)
     2038      REAL(KIND=8) PTR2(KDLON)  ! LAYER TRANSMISSIVITY
    20882039C
    20892040C* LOCAL VARIABLES:
    20902041C
    20912042      INTEGER jl
    2092       REAL*8 ZFF, ZGP, ZTOP, ZWCP, ZDT, ZX1, ZWM
    2093       REAL*8 ZRM2, ZRK, ZX2, ZRP, ZALPHA, ZBETA, ZARG
    2094       REAL*8 ZEXMU0, ZARG2, ZEXKP, ZEXKM, ZXP2P, ZXM2P, ZAP2B, ZAM2B
    2095       REAL*8 ZA11, ZA12, ZA13, ZA21, ZA22, ZA23
    2096       REAL*8 ZDENA, ZC1A, ZC2A, ZRI0A, ZRI1A
    2097       REAL*8 ZRI0B, ZRI1B
    2098       REAL*8 ZB21, ZB22, ZB23, ZDENB, ZC1B, ZC2B
    2099       REAL*8 ZRI0C, ZRI1C, ZRI0D, ZRI1D
     2043      REAL(KIND=8) ZFF, ZGP, ZTOP, ZWCP, ZDT, ZX1, ZWM
     2044      REAL(KIND=8) ZRM2, ZRK, ZX2, ZRP, ZALPHA, ZBETA, ZARG
     2045      REAL(KIND=8) ZEXMU0, ZARG2, ZEXKP, ZEXKM, ZXP2P, ZXM2P, ZAP2B,
     2046     $     ZAM2B
     2047      REAL(KIND=8) ZA11, ZA12, ZA13, ZA21, ZA22, ZA23
     2048      REAL(KIND=8) ZDENA, ZC1A, ZC2A, ZRI0A, ZRI1A
     2049      REAL(KIND=8) ZRI0B, ZRI1B
     2050      REAL(KIND=8) ZB21, ZB22, ZB23, ZDENB, ZC1B, ZC2B
     2051      REAL(KIND=8) ZRI0C, ZRI1C, ZRI0D, ZRI1D
    21002052C     ------------------------------------------------------------------
    21012053C
    … …  
    21752127      SUBROUTINE SWTT_LMDAR4 (KNU,KA,PU,PTR)
    21762128      USE dimphy
     2129      USE radiation_AR4_param, only : APAD, BPAD, D
    21772130      IMPLICIT none
    21782131cym#include "dimensions.h"
    … …  
    22122165      INTEGER KNU     ! INDEX OF THE SPECTRAL INTERVAL
    22132166      INTEGER KA      ! INDEX OF THE ABSORBER
    2214       REAL*8 PU(KDLON)  ! ABSORBER AMOUNT
    2215 C
    2216       REAL*8 PTR(KDLON) ! TRANSMISSION FUNCTION
     2167      REAL(KIND=8) PU(KDLON)  ! ABSORBER AMOUNT
     2168C
     2169      REAL(KIND=8) PTR(KDLON) ! TRANSMISSION FUNCTION
    22172170C
    22182171C* LOCAL VARIABLES:
    22192172C
    2220       REAL*8 ZR1(KDLON), ZR2(KDLON)
     2173      REAL(KIND=8) ZR1(KDLON), ZR2(KDLON)
    22212174      INTEGER jl, i,j
    22222175C
    2223 C* Prescribed Data:
    2224 C
    2225       REAL*8 APAD(2,3,7), BPAD(2,3,7), D(2,3)
    2226       SAVE APAD, BPAD, D
    2227 c$OMP THREADPRIVATE(APAD, BPAD, D)
    2228       DATA ((APAD(1,I,J),I=1,3),J=1,7) /
    2229      S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04,
    2230      S 0.723613782E+05, 0.000000000E-00, 0.129353723E-01,
    2231      S 0.596037057E+04, 0.000000000E-00, 0.800821928E+00,
    2232      S 0.000000000E-00, 0.000000000E-00, 0.242715973E+02,
    2233      S 0.000000000E-00, 0.000000000E-00, 0.878331486E+02,
    2234      S 0.000000000E-00, 0.000000000E-00, 0.191559725E+02,
    2235      S 0.000000000E-00, 0.000000000E-00, 0.000000000E+00 /
    2236       DATA ((APAD(2,I,J),I=1,3),J=1,7) /
    2237      S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03,
    2238      S 0.978576773E-04, 0.131849595E-03, 0.672595424E+02,
    2239      S 0.387714006E+00, 0.437772681E+00, 0.000000000E-00,
    2240      S 0.118461660E+03, 0.151345118E+03, 0.000000000E-00,
    2241      S 0.119079797E+04, 0.233628890E+04, 0.000000000E-00,
    2242      S 0.293353397E+03, 0.797219934E+03, 0.000000000E-00,
    2243      S 0.000000000E+00, 0.000000000E+00, 0.000000000E+00 /
    2244 C
    2245       DATA ((BPAD(1,I,J),I=1,3),J=1,7) /
    2246      S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04,
    2247      S 0.724555318E+05, 0.000000000E-00, 0.131812683E-01,
    2248      S 0.602593328E+04, 0.000000000E-00, 0.812706117E+00,
    2249      S 0.100000000E+01, 0.000000000E-00, 0.249863591E+02,
    2250      S 0.000000000E-00, 0.000000000E-00, 0.931071925E+02,
    2251      S 0.000000000E-00, 0.000000000E-00, 0.252233437E+02,
    2252      S 0.000000000E-00, 0.000000000E-00, 0.100000000E+01 /
    2253       DATA ((BPAD(2,I,J),I=1,3),J=1,7) /
    2254      S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03,
    2255      S 0.979023421E-04, 0.131861712E-03, 0.731185438E+02,
    2256      S 0.388611139E+00, 0.437949001E+00, 0.100000000E+01,
    2257      S 0.120291383E+03, 0.151692730E+03, 0.000000000E+00,
    2258      S 0.130531005E+04, 0.237071130E+04, 0.000000000E+00,
    2259      S 0.415049409E+03, 0.867914360E+03, 0.000000000E+00,
    2260      S 0.100000000E+01, 0.100000000E+01, 0.000000000E+00 /
    2261 c
    2262       DATA (D(1,I),I=1,3) / 0.00, 0.00, 0.00 /
    2263       DATA (D(2,I),I=1,3) / 0.000000000, 0.000000000, 0.800000000 /
     2176
    22642177C
    22652178C-----------------------------------------------------------------------
    … …  
    22932206      SUBROUTINE SWTT1_LMDAR4(KNU,KABS,KIND, PU, PTR)
    22942207      USE dimphy
     2208      USE radiation_AR4_param, only : APAD, BPAD, D
    22952209      IMPLICIT none
    22962210cym#include "dimensions.h"
    … …  
    23302244      INTEGER KABS         ! NUMBER OF ABSORBERS
    23312245      INTEGER KIND(KABS)   ! INDICES OF THE ABSORBERS
    2332       REAL*8 PU(KDLON,KABS)  ! ABSORBER AMOUNT
    2333 C
    2334       REAL*8 PTR(KDLON,KABS) ! TRANSMISSION FUNCTION
     2246      REAL(KIND=8) PU(KDLON,KABS)  ! ABSORBER AMOUNT
     2247C
     2248      REAL(KIND=8) PTR(KDLON,KABS) ! TRANSMISSION FUNCTION
    23352249C
    23362250C* LOCAL VARIABLES:
    23372251C
    2338       REAL*8 ZR1(KDLON)
    2339       REAL*8 ZR2(KDLON)
    2340       REAL*8 ZU(KDLON)
     2252      REAL(KIND=8) ZR1(KDLON)
     2253      REAL(KIND=8) ZR2(KDLON)
     2254      REAL(KIND=8) ZU(KDLON)
    23412255      INTEGER jl, ja, i, j, ia
    23422256C
    2343 C* Prescribed Data:
    2344 C
    2345       REAL*8 APAD(2,3,7), BPAD(2,3,7), D(2,3)
    2346       SAVE APAD, BPAD, D
    2347 c$OMP THREADPRIVATE(APAD, BPAD, D)
    2348       DATA ((APAD(1,I,J),I=1,3),J=1,7) /
    2349      S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04,
    2350      S 0.723613782E+05, 0.000000000E-00, 0.129353723E-01,
    2351      S 0.596037057E+04, 0.000000000E-00, 0.800821928E+00,
    2352      S 0.000000000E-00, 0.000000000E-00, 0.242715973E+02,
    2353      S 0.000000000E-00, 0.000000000E-00, 0.878331486E+02,
    2354      S 0.000000000E-00, 0.000000000E-00, 0.191559725E+02,
    2355      S 0.000000000E-00, 0.000000000E-00, 0.000000000E+00 /
    2356       DATA ((APAD(2,I,J),I=1,3),J=1,7) /
    2357      S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03,
    2358      S 0.978576773E-04, 0.131849595E-03, 0.672595424E+02,
    2359      S 0.387714006E+00, 0.437772681E+00, 0.000000000E-00,
    2360      S 0.118461660E+03, 0.151345118E+03, 0.000000000E-00,
    2361      S 0.119079797E+04, 0.233628890E+04, 0.000000000E-00,
    2362      S 0.293353397E+03, 0.797219934E+03, 0.000000000E-00,
    2363      S 0.000000000E+00, 0.000000000E+00, 0.000000000E+00 /
    2364 C
    2365       DATA ((BPAD(1,I,J),I=1,3),J=1,7) /
    2366      S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04,
    2367      S 0.724555318E+05, 0.000000000E-00, 0.131812683E-01,
    2368      S 0.602593328E+04, 0.000000000E-00, 0.812706117E+00,
    2369      S 0.100000000E+01, 0.000000000E-00, 0.249863591E+02,
    2370      S 0.000000000E-00, 0.000000000E-00, 0.931071925E+02,
    2371      S 0.000000000E-00, 0.000000000E-00, 0.252233437E+02,
    2372      S 0.000000000E-00, 0.000000000E-00, 0.100000000E+01 /
    2373       DATA ((BPAD(2,I,J),I=1,3),J=1,7) /
    2374      S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03,
    2375      S 0.979023421E-04, 0.131861712E-03, 0.731185438E+02,
    2376      S 0.388611139E+00, 0.437949001E+00, 0.100000000E+01,
    2377      S 0.120291383E+03, 0.151692730E+03, 0.000000000E+00,
    2378      S 0.130531005E+04, 0.237071130E+04, 0.000000000E+00,
    2379      S 0.415049409E+03, 0.867914360E+03, 0.000000000E+00,
    2380      S 0.100000000E+01, 0.100000000E+01, 0.000000000E+00 /
    2381 c
    2382       DATA (D(1,I),I=1,3) / 0.00, 0.00, 0.00 /
    2383       DATA (D(2,I),I=1,3) / 0.000000000, 0.000000000, 0.800000000 /
     2257
    23842258C-----------------------------------------------------------------------
    23852259C
    … …  
    24642338C-----------------------------------------------------------------------
    24652339cIM ctes ds clesphys.h
    2466 c     REAL*8 RCO2   ! CO2 CONCENTRATION (IPCC:353.E-06* 44.011/28.97)
    2467 c     REAL*8 RCH4   ! CH4 CONCENTRATION (IPCC: 1.72E-06* 16.043/28.97)
    2468 c     REAL*8 RN2O   ! N2O CONCENTRATION (IPCC: 310.E-09* 44.013/28.97)
    2469 c     REAL*8 RCFC11 ! CFC11 CONCENTRATION (IPCC: 280.E-12* 137.3686/28.97)
    2470 c     REAL*8 RCFC12 ! CFC12 CONCENTRATION (IPCC: 484.E-12* 120.9140/28.97)
     2340c     REAL(KIND=8) RCO2   ! CO2 CONCENTRATION (IPCC:353.E-06* 44.011/28.97)
     2341c     REAL(KIND=8) RCH4   ! CH4 CONCENTRATION (IPCC: 1.72E-06* 16.043/28.97)
     2342c     REAL(KIND=8) RN2O   ! N2O CONCENTRATION (IPCC: 310.E-09* 44.013/28.97)
     2343c     REAL(KIND=8) RCFC11 ! CFC11 CONCENTRATION (IPCC: 280.E-12* 137.3686/28.97)
     2344c     REAL(KIND=8) RCFC12 ! CFC12 CONCENTRATION (IPCC: 484.E-12* 120.9140/28.97)
    24712345#include "clesphys.h"
    2472       REAL*8 PCLDLD(KDLON,KFLEV)  ! DOWNWARD EFFECTIVE CLOUD COVER
    2473       REAL*8 PCLDLU(KDLON,KFLEV)  ! UPWARD EFFECTIVE CLOUD COVER
    2474       REAL*8 PDP(KDLON,KFLEV)     ! LAYER PRESSURE THICKNESS (Pa)
    2475       REAL*8 PDT0(KDLON)          ! SURFACE TEMPERATURE DISCONTINUITY (K)
    2476       REAL*8 PEMIS(KDLON)         ! SURFACE EMISSIVITY
    2477       REAL*8 PPMB(KDLON,KFLEV+1)  ! HALF LEVEL PRESSURE (mb)
    2478       REAL*8 PPSOL(KDLON)         ! SURFACE PRESSURE (Pa)
    2479       REAL*8 POZON(KDLON,KFLEV)   ! O3 CONCENTRATION (kg/kg)
    2480       REAL*8 PTL(KDLON,KFLEV+1)   ! HALF LEVEL TEMPERATURE (K)
    2481       REAL*8 PAER(KDLON,KFLEV,5)  ! OPTICAL THICKNESS OF THE AEROSOLS
    2482       REAL*8 PTAVE(KDLON,KFLEV)   ! LAYER TEMPERATURE (K)
    2483       REAL*8 PVIEW(KDLON)         ! COSECANT OF VIEWING ANGLE
    2484       REAL*8 PWV(KDLON,KFLEV)     ! SPECIFIC HUMIDITY (kg/kg)
    2485 C
    2486       REAL*8 PCOLR(KDLON,KFLEV)   ! LONG-WAVE TENDENCY (K/day)
    2487       REAL*8 PCOLR0(KDLON,KFLEV)  ! LONG-WAVE TENDENCY (K/day) clear-sky
    2488       REAL*8 PTOPLW(KDLON)        ! LONGWAVE FLUX AT T.O.A.
    2489       REAL*8 PSOLLW(KDLON)        ! LONGWAVE FLUX AT SURFACE
    2490       REAL*8 PTOPLW0(KDLON)       ! LONGWAVE FLUX AT T.O.A. (CLEAR-SKY)
    2491       REAL*8 PSOLLW0(KDLON)       ! LONGWAVE FLUX AT SURFACE (CLEAR-SKY)
     2346      REAL(KIND=8) PCLDLD(KDLON,KFLEV)  ! DOWNWARD EFFECTIVE CLOUD COVER
     2347      REAL(KIND=8) PCLDLU(KDLON,KFLEV)  ! UPWARD EFFECTIVE CLOUD COVER
     2348      REAL(KIND=8) PDP(KDLON,KFLEV)     ! LAYER PRESSURE THICKNESS (Pa)
     2349      REAL(KIND=8) PDT0(KDLON)          ! SURFACE TEMPERATURE DISCONTINUITY (K)
     2350      REAL(KIND=8) PEMIS(KDLON)         ! SURFACE EMISSIVITY
     2351      REAL(KIND=8) PPMB(KDLON,KFLEV+1)  ! HALF LEVEL PRESSURE (mb)
     2352      REAL(KIND=8) PPSOL(KDLON)         ! SURFACE PRESSURE (Pa)
     2353      REAL(KIND=8) POZON(KDLON,KFLEV)   ! O3 mass fraction
     2354      REAL(KIND=8) PTL(KDLON,KFLEV+1)   ! HALF LEVEL TEMPERATURE (K)
     2355      REAL(KIND=8) PAER(KDLON,KFLEV,5)  ! OPTICAL THICKNESS OF THE AEROSOLS
     2356      REAL(KIND=8) PTAVE(KDLON,KFLEV)   ! LAYER TEMPERATURE (K)
     2357      REAL(KIND=8) PVIEW(KDLON)         ! COSECANT OF VIEWING ANGLE
     2358      REAL(KIND=8) PWV(KDLON,KFLEV)     ! SPECIFIC HUMIDITY (kg/kg)
     2359C
     2360      REAL(KIND=8) PCOLR(KDLON,KFLEV)   ! LONG-WAVE TENDENCY (K/day)
     2361      REAL(KIND=8) PCOLR0(KDLON,KFLEV)  ! LONG-WAVE TENDENCY (K/day) clear-sky
     2362      REAL(KIND=8) PTOPLW(KDLON)        ! LONGWAVE FLUX AT T.O.A.
     2363      REAL(KIND=8) PSOLLW(KDLON)        ! LONGWAVE FLUX AT SURFACE
     2364      REAL(KIND=8) PTOPLW0(KDLON)       ! LONGWAVE FLUX AT T.O.A. (CLEAR-SKY)
     2365      REAL(KIND=8) PSOLLW0(KDLON)       ! LONGWAVE FLUX AT SURFACE (CLEAR-SKY)
    24922366c Rajout LF
    2493       real*8 psollwdown(kdlon)    ! LONGWAVE downwards flux at surface
     2367      real(kind=8) psollwdown(kdlon)    ! LONGWAVE downwards flux at surface
    24942368c Rajout IM
    2495 cIM   real*8 psollwdownclr(kdlon) ! LONGWAVE CS downwards flux at surface
    2496 cIM   real*8 ptoplwdown(kdlon)    ! LONGWAVE downwards flux at T.O.A.
    2497 cIM   real*8 ptoplwdownclr(kdlon) ! LONGWAVE CS downwards flux at T.O.A.
     2369cIM   real(kind=8) psollwdownclr(kdlon) ! LONGWAVE CS downwards flux at surface
     2370cIM   real(kind=8) ptoplwdown(kdlon)    ! LONGWAVE downwards flux at T.O.A.
     2371cIM   real(kind=8) ptoplwdownclr(kdlon) ! LONGWAVE CS downwards flux at T.O.A.
    24982372cIM
    2499       REAL*8 plwup(KDLON,KFLEV+1)  ! LW up total sky
    2500       REAL*8 plwup0(KDLON,KFLEV+1) ! LW up clear sky
    2501       REAL*8 plwdn(KDLON,KFLEV+1)  ! LW down total sky
    2502       REAL*8 plwdn0(KDLON,KFLEV+1) ! LW down clear sky
     2373      REAL(KIND=8) plwup(KDLON,KFLEV+1)  ! LW up total sky
     2374      REAL(KIND=8) plwup0(KDLON,KFLEV+1) ! LW up clear sky
     2375      REAL(KIND=8) plwdn(KDLON,KFLEV+1)  ! LW down total sky
     2376      REAL(KIND=8) plwdn0(KDLON,KFLEV+1) ! LW down clear sky
    25032377C-------------------------------------------------------------------------
    2504       REAL*8 ZABCU(KDLON,NUA,3*KFLEV+1)
    2505       REAL*8 ZOZ(KDLON,KFLEV)
    2506 c
    2507 cym      REAL*8 ZFLUX(KDLON,2,KFLEV+1) ! RADIATIVE FLUXES (1:up; 2:down)
    2508 cym      REAL*8 ZFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
    2509 cym      REAL*8 ZBINT(KDLON,KFLEV+1)            ! Intermediate variable
    2510 cym      REAL*8 ZBSUI(KDLON)                    ! Intermediate variable
    2511 cym      REAL*8,ZCTS(KDLON,KFLEV)               ! Intermediate variable
    2512 cym      REAL*8 ZCNTRB(KDLON,KFLEV+1,KFLEV+1)   ! Intermediate variable
     2378      REAL(KIND=8) ZABCU(KDLON,NUA,3*KFLEV+1)
     2379
     2380      REAL(KIND=8) ZOZ(KDLON,KFLEV)
     2381!     equivalent pressure of ozone in a layer, in Pa
     2382
     2383cym      REAL(KIND=8) ZFLUX(KDLON,2,KFLEV+1) ! RADIATIVE FLUXES (1:up; 2:down)
     2384cym      REAL(KIND=8) ZFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
     2385cym      REAL(KIND=8) ZBINT(KDLON,KFLEV+1)            ! Intermediate variable
     2386cym      REAL(KIND=8) ZBSUI(KDLON)                    ! Intermediate variable
     2387cym      REAL(KIND=8) ZCTS(KDLON,KFLEV)               ! Intermediate variable
     2388cym      REAL(KIND=8) ZCNTRB(KDLON,KFLEV+1,KFLEV+1)   ! Intermediate variable
    25132389cym      SAVE ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB
    2514       REAL*8,allocatable,save :: ZFLUX(:,:,:) ! RADIATIVE FLUXES (1:up; 2:down)
    2515       REAL*8,allocatable,save :: ZFLUC(:,:,:) ! CLEAR-SKY RADIATIVE FLUXES
    2516       REAL*8,allocatable,save :: ZBINT(:,:)            ! Intermediate variable
    2517       REAL*8,allocatable,save :: ZBSUI(:)                    ! Intermediate variable
    2518       REAL*8,allocatable,save :: ZCTS(:,:)               ! Intermediate variable
    2519       REAL*8,allocatable,save :: ZCNTRB(:,:,:)   ! Intermediate variable
     2390      REAL(KIND=8),allocatable,save :: ZFLUX(:,:,:) ! RADIATIVE FLUXES (1:up; 2:down)
     2391      REAL(KIND=8),allocatable,save :: ZFLUC(:,:,:) ! CLEAR-SKY RADIATIVE FLUXES
     2392      REAL(KIND=8),allocatable,save :: ZBINT(:,:)            ! Intermediate variable
     2393      REAL(KIND=8),allocatable,save :: ZBSUI(:)                    ! Intermediate variable
     2394      REAL(KIND=8),allocatable,save :: ZCTS(:,:)               ! Intermediate variable
     2395      REAL(KIND=8),allocatable,save :: ZCNTRB(:,:,:)   ! Intermediate variable
    25202396c$OMP THREADPRIVATE(ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB)
    25212397c
    … …  
    25502426C
    25512427      IF (MOD(itaplw0,lw0pas).EQ.0) THEN
    2552       DO k = 1, KFLEV  ! convertir ozone de kg/kg en pa/pa
    2553       DO i = 1, KDLON
    2554 c convertir ozone de kg/kg en pa (modif MPL 100505)
    2555          ZOZ(i,k) = POZON(i,k)*PDP(i,k) * RMD/RMO3
    2556 c        print *,'LW: ZOZ*10**6=',ZOZ(i,k)*1000000.
    2557       ENDDO
     2428c     Compute equivalent pressure of ozone from mass fraction:
     2429      DO k = 1, KFLEV
     2430         DO i = 1, KDLON
     2431            ZOZ(i,k) = POZON(i,k)*PDP(i,k)
     2432         ENDDO
    25582433      ENDDO
    25592434cIM ctes ds clesphys.h   CALL LWU(RCO2,RCH4, RN2O, RCFC11, RCFC12,
    … …  
    26092484     S               PABCU)
    26102485      USE dimphy
     2486      USE radiation_AR4_param, only : TREF, RT1, RAER, AT, BT, OCT
    26112487      IMPLICIT none
    26122488cym#include "dimensions.h"
    … …  
    26472523C* ARGUMENTS:
    26482524cIM ctes ds clesphys.h
    2649 c     REAL*8 RCO2
    2650 c     REAL*8 RCH4, RN2O, RCFC11, RCFC12
     2525c     REAL(KIND=8) RCO2
     2526c     REAL(KIND=8) RCH4, RN2O, RCFC11, RCFC12
    26512527#include "clesphys.h"
    2652       REAL*8 PAER(KDLON,KFLEV,5)
    2653       REAL*8 PDP(KDLON,KFLEV)
    2654       REAL*8 PPMB(KDLON,KFLEV+1)
    2655       REAL*8 PPSOL(KDLON)
    2656       REAL*8 POZ(KDLON,KFLEV)
    2657       REAL*8 PTAVE(KDLON,KFLEV)
    2658       REAL*8 PVIEW(KDLON)
    2659       REAL*8 PWV(KDLON,KFLEV)
    2660 C
    2661       REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS
     2528      REAL(KIND=8) PAER(KDLON,KFLEV,5)
     2529      REAL(KIND=8) PDP(KDLON,KFLEV)
     2530      REAL(KIND=8) PPMB(KDLON,KFLEV+1)
     2531      REAL(KIND=8) PPSOL(KDLON)
     2532      REAL(KIND=8) POZ(KDLON,KFLEV)
     2533      REAL(KIND=8) PTAVE(KDLON,KFLEV)
     2534      REAL(KIND=8) PVIEW(KDLON)
     2535      REAL(KIND=8) PWV(KDLON,KFLEV)
     2536C
     2537      REAL(KIND=8) PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS
    26622538C
    26632539C-----------------------------------------------------------------------
    26642540C* LOCAL VARIABLES:
    2665       REAL*8 ZABLY(KDLON,NUA,3*KFLEV+1)
    2666       REAL*8 ZDUC(KDLON,3*KFLEV+1)
    2667       REAL*8 ZPHIO(KDLON)
    2668       REAL*8 ZPSC2(KDLON)
    2669       REAL*8 ZPSC3(KDLON)
    2670       REAL*8 ZPSH1(KDLON)
    2671       REAL*8 ZPSH2(KDLON)
    2672       REAL*8 ZPSH3(KDLON)
    2673       REAL*8 ZPSH4(KDLON)
    2674       REAL*8 ZPSH5(KDLON)
    2675       REAL*8 ZPSH6(KDLON)
    2676       REAL*8 ZPSIO(KDLON)
    2677       REAL*8 ZTCON(KDLON)
    2678       REAL*8 ZPHM6(KDLON)
    2679       REAL*8 ZPSM6(KDLON)
    2680       REAL*8 ZPHN6(KDLON)
    2681       REAL*8 ZPSN6(KDLON)
    2682       REAL*8 ZSSIG(KDLON,3*KFLEV+1)
    2683       REAL*8 ZTAVI(KDLON)
    2684       REAL*8 ZUAER(KDLON,Ninter)
    2685       REAL*8 ZXOZ(KDLON)
    2686       REAL*8 ZXWV(KDLON)
     2541      REAL(KIND=8) ZABLY(KDLON,NUA,3*KFLEV+1)
     2542      REAL(KIND=8) ZDUC(KDLON,3*KFLEV+1)
     2543      REAL(KIND=8) ZPHIO(KDLON)
     2544      REAL(KIND=8) ZPSC2(KDLON)
     2545      REAL(KIND=8) ZPSC3(KDLON)
     2546      REAL(KIND=8) ZPSH1(KDLON)
     2547      REAL(KIND=8) ZPSH2(KDLON)
     2548      REAL(KIND=8) ZPSH3(KDLON)
     2549      REAL(KIND=8) ZPSH4(KDLON)
     2550      REAL(KIND=8) ZPSH5(KDLON)
     2551      REAL(KIND=8) ZPSH6(KDLON)
     2552      REAL(KIND=8) ZPSIO(KDLON)
     2553      REAL(KIND=8) ZTCON(KDLON)
     2554      REAL(KIND=8) ZPHM6(KDLON)
     2555      REAL(KIND=8) ZPSM6(KDLON)
     2556      REAL(KIND=8) ZPHN6(KDLON)
     2557      REAL(KIND=8) ZPSN6(KDLON)
     2558      REAL(KIND=8) ZSSIG(KDLON,3*KFLEV+1)
     2559      REAL(KIND=8) ZTAVI(KDLON)
     2560      REAL(KIND=8) ZUAER(KDLON,Ninter)
     2561      REAL(KIND=8) ZXOZ(KDLON)
     2562      REAL(KIND=8) ZXWV(KDLON)
    26872563C
    26882564      INTEGER jl, jk, jkj, jkjr, jkjp, ig1
    … …  
    26912567      INTEGER jae1, jae2, jae3, jae, jjpn
    26922568      INTEGER ir, jc, jcp1
    2693       REAL*8 zdpm, zupm, zupmh2o, zupmco2, zupmo3, zu6, zup
    2694       REAL*8 zfppw, ztx, ztx2, zzably
    2695       REAL*8 zcah1, zcbh1, zcah2, zcbh2, zcah3, zcbh3
    2696       REAL*8 zcah4, zcbh4, zcah5, zcbh5, zcah6, zcbh6
    2697       REAL*8 zcac8, zcbc8
    2698       REAL*8 zalup, zdiff
     2569      REAL(KIND=8) zdpm, zupm, zupmh2o, zupmco2, zupmo3, zu6, zup
     2570      REAL(KIND=8) zfppw, ztx, ztx2, zzably
     2571      REAL(KIND=8) zcah1, zcbh1, zcah2, zcbh2, zcah3, zcbh3
     2572      REAL(KIND=8) zcah4, zcbh4, zcah5, zcbh5, zcah6, zcbh6
     2573      REAL(KIND=8) zcac8, zcbc8
     2574      REAL(KIND=8) zalup, zdiff
    26992575c
    2700       REAL*8 PVGCO2, PVGH2O, PVGO3
    2701 C
    2702       REAL*8 R10E  ! DECIMAL/NATURAL LOG.FACTOR
     2576      REAL(KIND=8) PVGCO2, PVGH2O, PVGO3
     2577C
     2578      REAL(KIND=8) R10E  ! DECIMAL/NATURAL LOG.FACTOR
    27032579      PARAMETER (R10E=0.4342945)
    2704 c
    2705 c Used Data Block:
    2706 c
    2707       REAL*8 TREF
    2708       SAVE TREF
    2709 c$OMP THREADPRIVATE(TREF)
    2710       REAL*8 RT1(2)
    2711       SAVE RT1
    2712 c$OMP THREADPRIVATE(RT1)
    2713       REAL*8 RAER(5,5)
    2714       SAVE RAER
    2715 c$OMP THREADPRIVATE(RAER)
    2716       REAL*8 AT(8,3), BT(8,3)
    2717       SAVE AT, BT
    2718 c$OMP THREADPRIVATE(AT, BT)
    2719       REAL*8 OCT(4)
    2720       SAVE OCT
    2721 c$OMP THREADPRIVATE(OCT)
    2722       DATA TREF /250.0/
    2723       DATA (RT1(IG1),IG1=1,2) / -0.577350269, +0.577350269 /
    2724       DATA RAER / .038520, .037196, .040532, .054934, .038520
    2725      1          , .12613 , .18313 , .10357 , .064106, .126130
    2726      2          , .012579, .013649, .018652, .025181, .012579
    2727      3          , .011890, .016142, .021105, .028908, .011890
    2728      4          , .013792, .026810, .052203, .066338, .013792 /
    2729       DATA (AT(1,IR),IR=1,3) /
    2730      S 0.298199E-02,-.394023E-03,0.319566E-04 /
    2731       DATA (BT(1,IR),IR=1,3) /
    2732      S-0.106432E-04,0.660324E-06,0.174356E-06 /
    2733       DATA (AT(2,IR),IR=1,3) /
    2734      S 0.143676E-01,0.366501E-02,-.160822E-02 /
    2735       DATA (BT(2,IR),IR=1,3) /
    2736      S-0.553979E-04,-.101701E-04,0.920868E-05 /
    2737       DATA (AT(3,IR),IR=1,3) /
    2738      S 0.197861E-01,0.315541E-02,-.174547E-02 /
    2739       DATA (BT(3,IR),IR=1,3) /
    2740      S-0.877012E-04,0.513302E-04,0.523138E-06 /
    2741       DATA (AT(4,IR),IR=1,3) /
    2742      S 0.289560E-01,-.208807E-02,-.121943E-02 /
    2743       DATA (BT(4,IR),IR=1,3) /
    2744      S-0.165960E-03,0.157704E-03,-.146427E-04 /
    2745       DATA (AT(5,IR),IR=1,3) /
    2746      S 0.103800E-01,0.436296E-02,-.161431E-02 /
    2747       DATA (BT(5,IR),IR=1,3) /
    2748      S -.276744E-04,-.327381E-04,0.127646E-04 /
    2749       DATA (AT(6,IR),IR=1,3) /
    2750      S 0.868859E-02,-.972752E-03,0.000000E-00 /
    2751       DATA (BT(6,IR),IR=1,3) /
    2752      S -.278412E-04,-.713940E-06,0.117469E-05 /
    2753       DATA (AT(7,IR),IR=1,3) /
    2754      S 0.250073E-03,0.455875E-03,0.109242E-03 /
    2755       DATA (BT(7,IR),IR=1,3) /
    2756      S 0.199846E-05,-.216313E-05,0.175991E-06 /
    2757       DATA (AT(8,IR),IR=1,3) /
    2758      S 0.307423E-01,0.110879E-02,-.322172E-03 /
    2759       DATA (BT(8,IR),IR=1,3) /
    2760      S-0.108482E-03,0.258096E-05,-.814575E-06 /
    2761 c
    2762       DATA OCT /-.326E-03, -.102E-05, .137E-02, -.535E-05/
     2580
    27632581C-----------------------------------------------------------------------
    27642582c
    … …  
    30482866      INTEGER KLIM
    30492867C
    3050       REAL*8 PDP(KDLON,KFLEV)
    3051       REAL*8 PDT0(KDLON)
    3052       REAL*8 PEMIS(KDLON)
    3053       REAL*8 PPMB(KDLON,KFLEV+1)
    3054       REAL*8 PTL(KDLON,KFLEV+1)
    3055       REAL*8 PTAVE(KDLON,KFLEV)
    3056 C
    3057       REAL*8 PFLUC(KDLON,2,KFLEV+1)
     2868      REAL(KIND=8) PDP(KDLON,KFLEV)
     2869      REAL(KIND=8) PDT0(KDLON)
     2870      REAL(KIND=8) PEMIS(KDLON)
     2871      REAL(KIND=8) PPMB(KDLON,KFLEV+1)
     2872      REAL(KIND=8) PTL(KDLON,KFLEV+1)
     2873      REAL(KIND=8) PTAVE(KDLON,KFLEV)
     2874C
     2875      REAL(KIND=8) PFLUC(KDLON,2,KFLEV+1)
    30582876C     
    3059       REAL*8 PABCU(KDLON,NUA,3*KFLEV+1)
    3060       REAL*8 PBINT(KDLON,KFLEV+1)
    3061       REAL*8 PBSUI(KDLON)
    3062       REAL*8 PCTS(KDLON,KFLEV)
    3063       REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1)
     2877      REAL(KIND=8) PABCU(KDLON,NUA,3*KFLEV+1)
     2878      REAL(KIND=8) PBINT(KDLON,KFLEV+1)
     2879      REAL(KIND=8) PBSUI(KDLON)
     2880      REAL(KIND=8) PCTS(KDLON,KFLEV)
     2881      REAL(KIND=8) PCNTRB(KDLON,KFLEV+1,KFLEV+1)
    30642882C
    30652883C-------------------------------------------------------------------------
    30662884C
    30672885C* LOCAL VARIABLES:
    3068       REAL*8 ZB(KDLON,Ninter,KFLEV+1)
    3069       REAL*8 ZBSUR(KDLON,Ninter)
    3070       REAL*8 ZBTOP(KDLON,Ninter)
    3071       REAL*8 ZDBSL(KDLON,Ninter,KFLEV*2)
    3072       REAL*8 ZGA(KDLON,8,2,KFLEV)
    3073       REAL*8 ZGB(KDLON,8,2,KFLEV)
    3074       REAL*8 ZGASUR(KDLON,8,2)
    3075       REAL*8 ZGBSUR(KDLON,8,2)
    3076       REAL*8 ZGATOP(KDLON,8,2)
    3077       REAL*8 ZGBTOP(KDLON,8,2)
     2886      REAL(KIND=8) ZB(KDLON,Ninter,KFLEV+1)
     2887      REAL(KIND=8) ZBSUR(KDLON,Ninter)
     2888      REAL(KIND=8) ZBTOP(KDLON,Ninter)
     2889      REAL(KIND=8) ZDBSL(KDLON,Ninter,KFLEV*2)
     2890      REAL(KIND=8) ZGA(KDLON,8,2,KFLEV)
     2891      REAL(KIND=8) ZGB(KDLON,8,2,KFLEV)
     2892      REAL(KIND=8) ZGASUR(KDLON,8,2)
     2893      REAL(KIND=8) ZGBSUR(KDLON,8,2)
     2894      REAL(KIND=8) ZGATOP(KDLON,8,2)
     2895      REAL(KIND=8) ZGBTOP(KDLON,8,2)
    30782896C
    30792897      INTEGER nuaer, ntraer
    … …  
    31512969C* ARGUMENTS:
    31522970      INTEGER klim
    3153       REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
    3154       REAL*8 PBINT(KDLON,KFLEV+1)   ! HALF LEVEL PLANCK FUNCTION
    3155       REAL*8 PBSUIN(KDLON)          ! SURFACE PLANCK FUNCTION
    3156       REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) !CLEAR-SKY ENERGY EXCHANGE
    3157       REAL*8 PCTS(KDLON,KFLEV)      ! CLEAR-SKY LAYER COOLING-TO-SPACE
     2971      REAL(KIND=8) PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
     2972      REAL(KIND=8) PBINT(KDLON,KFLEV+1)   ! HALF LEVEL PLANCK FUNCTION
     2973      REAL(KIND=8) PBSUIN(KDLON)          ! SURFACE PLANCK FUNCTION
     2974      REAL(KIND=8) PCNTRB(KDLON,KFLEV+1,KFLEV+1) !CLEAR-SKY ENERGY EXCHANGE
     2975      REAL(KIND=8) PCTS(KDLON,KFLEV)      ! CLEAR-SKY LAYER COOLING-TO-SPACE
    31582976c
    3159       REAL*8 PCLDLD(KDLON,KFLEV)
    3160       REAL*8 PCLDLU(KDLON,KFLEV)
    3161       REAL*8 PEMIS(KDLON)
    3162 C
    3163       REAL*8 PFLUX(KDLON,2,KFLEV+1)
     2977      REAL(KIND=8) PCLDLD(KDLON,KFLEV)
     2978      REAL(KIND=8) PCLDLU(KDLON,KFLEV)
     2979      REAL(KIND=8) PEMIS(KDLON)
     2980C
     2981      REAL(KIND=8) PFLUX(KDLON,2,KFLEV+1)
    31642982C-----------------------------------------------------------------------
    31652983C* LOCAL VARIABLES:
    31662984      INTEGER IMX(KDLON), IMXP(KDLON)
    31672985C
    3168       REAL*8 ZCLEAR(KDLON),ZCLOUD(KDLON),ZDNF(KDLON,KFLEV+1,KFLEV+1)
     2986      REAL(KIND=8) ZCLEAR(KDLON),ZCLOUD(KDLON),
     2987     $     ZDNF(KDLON,KFLEV+1,KFLEV+1)
    31692988     S  , ZFD(KDLON), ZFN10(KDLON), ZFU(KDLON)
    31702989     S  , ZUPF(KDLON,KFLEV+1,KFLEV+1)
    3171       REAL*8 ZCLM(KDLON,KFLEV+1,KFLEV+1)
     2990      REAL(KIND=8) ZCLM(KDLON,KFLEV+1,KFLEV+1)
    31722991C
    31732992      INTEGER jk, jl, imaxc, imx1, imx2, jkj, jkp1, jkm1
    31742993      INTEGER jk1, jk2, jkc, jkcp1, jcloud
    31752994      INTEGER imxm1, imxp1
    3176       REAL*8 zcfrac
     2995      REAL(KIND=8) zcfrac
    31772996C     ------------------------------------------------------------------
    31782997C
    … …  
    35043323     S  , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP)
    35053324      USE dimphy
     3325      USE radiation_AR4_param, only : TINTP, XP, GA, GB
    35063326      IMPLICIT none
    35073327cym#include "dimensions.h"
    … …  
    35603380C ARGUMENTS:
    35613381C
    3562       REAL*8 PDT0(KDLON)
    3563       REAL*8 PTAVE(KDLON,KFLEV)
    3564       REAL*8 PTL(KDLON,KFLEV+1)
    3565 C
    3566       REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF LEVEL PLANCK FUNCTION
    3567       REAL*8 PBINT(KDLON,KFLEV+1) ! HALF LEVEL PLANCK FUNCTION
    3568       REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION
    3569       REAL*8 PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
    3570       REAL*8 PBTOP(KDLON,Ninter) ! TOP SPECTRAL PLANCK FUNCTION
    3571       REAL*8 PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
    3572       REAL*8 PGA(KDLON,8,2,KFLEV) ! dB/dT-weighted LAYER PADE APPROXIMANTS
    3573       REAL*8 PGB(KDLON,8,2,KFLEV) ! dB/dT-weighted LAYER PADE APPROXIMANTS
    3574       REAL*8 PGASUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
    3575       REAL*8 PGBSUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
    3576       REAL*8 PGATOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
    3577       REAL*8 PGBTOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
     3382      REAL(KIND=8) PDT0(KDLON)
     3383      REAL(KIND=8) PTAVE(KDLON,KFLEV)
     3384      REAL(KIND=8) PTL(KDLON,KFLEV+1)
     3385C
     3386      REAL(KIND=8) PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF LEVEL PLANCK FUNCTION
     3387      REAL(KIND=8) PBINT(KDLON,KFLEV+1) ! HALF LEVEL PLANCK FUNCTION
     3388      REAL(KIND=8) PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION
     3389      REAL(KIND=8) PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
     3390      REAL(KIND=8) PBTOP(KDLON,Ninter) ! TOP SPECTRAL PLANCK FUNCTION
     3391      REAL(KIND=8) PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
     3392      REAL(KIND=8) PGA(KDLON,8,2,KFLEV) ! dB/dT-weighted LAYER PADE APPROXIMANTS
     3393      REAL(KIND=8) PGB(KDLON,8,2,KFLEV) ! dB/dT-weighted LAYER PADE APPROXIMANTS
     3394      REAL(KIND=8) PGASUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
     3395      REAL(KIND=8) PGBSUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
     3396      REAL(KIND=8) PGATOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
     3397      REAL(KIND=8) PGBTOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
    35783398C
    35793399C-------------------------------------------------------------------------
    35803400C*  LOCAL VARIABLES:
    35813401      INTEGER INDB(KDLON),INDS(KDLON)
    3582       REAL*8 ZBLAY(KDLON,KFLEV),ZBLEV(KDLON,KFLEV+1)
    3583       REAL*8 ZRES(KDLON),ZRES2(KDLON),ZTI(KDLON),ZTI2(KDLON)
     3402      REAL(KIND=8) ZBLAY(KDLON,KFLEV),ZBLEV(KDLON,KFLEV+1)
     3403      REAL(KIND=8) ZRES(KDLON),ZRES2(KDLON),ZTI(KDLON),ZTI2(KDLON)
    35843404c
    35853405      INTEGER jk, jl, ic, jnu, jf, jg
    … …  
    35873407      INTEGER k, j, ixtox, indto, ixtx, indt
    35883408      INTEGER indsu, indtp
    3589       REAL*8 zdsto1, zdstox, zdst1, zdstx
     3409      REAL(KIND=8) zdsto1, zdstox, zdst1, zdstx
    35903410c
    35913411C* Quelques parametres:
    3592       REAL*8 TSTAND
     3412      REAL(KIND=8) TSTAND
    35933413      PARAMETER (TSTAND=250.0)
    3594       REAL*8 TSTP
     3414      REAL(KIND=8) TSTP
    35953415      PARAMETER (TSTP=12.5)
    35963416      INTEGER MXIXT
    … …  
    35983418C
    35993419C* Used Data Block:
    3600       REAL*8 TINTP(11)
    3601       SAVE TINTP
    3602 c$OMP THREADPRIVATE(TINTP)
    3603       REAL*8 GA(11,16,3), GB(11,16,3)
    3604       SAVE GA, GB
    3605 c$OMP THREADPRIVATE(GA, GB)
    3606       REAL*8 XP(6,6)
    3607       SAVE XP
    3608 c$OMP THREADPRIVATE(XP)
     3420c     REAL*8 TINTP(11)
     3421c     SAVE TINTP
     3422cc$OMP THREADPRIVATE(TINTP)
     3423c     REAL*8 GA(11,16,3), GB(11,16,3)
     3424c     SAVE GA, GB
     3425cc$OMP THREADPRIVATE(GA, GB)
     3426c     REAL*8 XP(6,6)
     3427c     SAVE XP
     3428cc$OMP THREADPRIVATE(XP)
    36093429c
    3610       DATA TINTP / 187.5, 200., 212.5, 225., 237.5, 250.,
    3611      S             262.5, 275., 287.5, 300., 312.5 /
     3430c     DATA TINTP / 187.5, 200., 212.5, 225., 237.5, 250.,
     3431c    S             262.5, 275., 287.5, 300., 312.5 /
    36123432C-----------------------------------------------------------------------
    36133433C-- WATER VAPOR -- INT.1 -- 0- 500 CM-1 -- FROM ABS225 ----------------
    … …  
    36223442C
    36233443C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    3624       DATA (GA( 1, 1,IC),IC=1,3) /
    3625      S 0.63499072E-02,-0.99506586E-03, 0.00000000E+00/
    3626       DATA (GB( 1, 1,IC),IC=1,3) /
    3627      S 0.63499072E-02, 0.97222852E-01, 0.10000000E+01/
    3628       DATA (GA( 1, 2,IC),IC=1,3) /
    3629      S 0.77266491E-02,-0.11661515E-02, 0.00000000E+00/
    3630       DATA (GB( 1, 2,IC),IC=1,3) /
    3631      S 0.77266491E-02, 0.10681591E+00, 0.10000000E+01/
     3444C     DATA (GA( 1, 1,IC),IC=1,3) /
     3445C    S 0.63499072E-02,-0.99506586E-03, 0.00000000E+00/
     3446C     DATA (GB( 1, 1,IC),IC=1,3) /
     3447C    S 0.63499072E-02, 0.97222852E-01, 0.10000000E+01/
     3448C     DATA (GA( 1, 2,IC),IC=1,3) /
     3449C    S 0.77266491E-02,-0.11661515E-02, 0.00000000E+00/
     3450C     DATA (GB( 1, 2,IC),IC=1,3) /
     3451C    S 0.77266491E-02, 0.10681591E+00, 0.10000000E+01/
    36323452C
    36333453C----- INTERVAL = 1 ----- T =  200.0
    36343454C
    36353455C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    3636       DATA (GA( 2, 1,IC),IC=1,3) /
    3637      S 0.65566348E-02,-0.10184169E-02, 0.00000000E+00/
    3638       DATA (GB( 2, 1,IC),IC=1,3) /
    3639      S 0.65566348E-02, 0.98862238E-01, 0.10000000E+01/
    3640       DATA (GA( 2, 2,IC),IC=1,3) /
    3641      S 0.81323287E-02,-0.11886130E-02, 0.00000000E+00/
    3642       DATA (GB( 2, 2,IC),IC=1,3) /
    3643      S 0.81323287E-02, 0.10921298E+00, 0.10000000E+01/
     3456C     DATA (GA( 2, 1,IC),IC=1,3) /
     3457C    S 0.65566348E-02,-0.10184169E-02, 0.00000000E+00/
     3458C     DATA (GB( 2, 1,IC),IC=1,3) /
     3459C    S 0.65566348E-02, 0.98862238E-01, 0.10000000E+01/
     3460C     DATA (GA( 2, 2,IC),IC=1,3) /
     3461C    S 0.81323287E-02,-0.11886130E-02, 0.00000000E+00/
     3462C     DATA (GB( 2, 2,IC),IC=1,3) /
     3463C    S 0.81323287E-02, 0.10921298E+00, 0.10000000E+01/
    36443464C
    36453465C----- INTERVAL = 1 ----- T =  212.5
    36463466C
    36473467C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    3648       DATA (GA( 3, 1,IC),IC=1,3) /
    3649      S 0.67849730E-02,-0.10404730E-02, 0.00000000E+00/
    3650       DATA (GB( 3, 1,IC),IC=1,3) /
    3651      S 0.67849730E-02, 0.10061504E+00, 0.10000000E+01/
    3652       DATA (GA( 3, 2,IC),IC=1,3) /
    3653      S 0.86507620E-02,-0.12139929E-02, 0.00000000E+00/
    3654       DATA (GB( 3, 2,IC),IC=1,3) /
    3655      S 0.86507620E-02, 0.11198225E+00, 0.10000000E+01/
     3468C     DATA (GA( 3, 1,IC),IC=1,3) /
     3469C    S 0.67849730E-02,-0.10404730E-02, 0.00000000E+00/
     3470C     DATA (GB( 3, 1,IC),IC=1,3) /
     3471C    S 0.67849730E-02, 0.10061504E+00, 0.10000000E+01/
     3472C     DATA (GA( 3, 2,IC),IC=1,3) /
     3473C    S 0.86507620E-02,-0.12139929E-02, 0.00000000E+00/
     3474C     DATA (GB( 3, 2,IC),IC=1,3) /
     3475C    S 0.86507620E-02, 0.11198225E+00, 0.10000000E+01/
    36563476C
    36573477C----- INTERVAL = 1 ----- T =  225.0
    36583478C
    36593479C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    3660       DATA (GA( 4, 1,IC),IC=1,3) /
    3661      S 0.70481947E-02,-0.10621792E-02, 0.00000000E+00/
    3662       DATA (GB( 4, 1,IC),IC=1,3) /
    3663      S 0.70481947E-02, 0.10256222E+00, 0.10000000E+01/
    3664       DATA (GA( 4, 2,IC),IC=1,3) /
    3665      S 0.92776391E-02,-0.12445811E-02, 0.00000000E+00/
    3666       DATA (GB( 4, 2,IC),IC=1,3) /
    3667      S 0.92776391E-02, 0.11487826E+00, 0.10000000E+01/
     3480C     DATA (GA( 4, 1,IC),IC=1,3) /
     3481C    S 0.70481947E-02,-0.10621792E-02, 0.00000000E+00/
     3482C     DATA (GB( 4, 1,IC),IC=1,3) /
     3483C    S 0.70481947E-02, 0.10256222E+00, 0.10000000E+01/
     3484C     DATA (GA( 4, 2,IC),IC=1,3) /
     3485C    S 0.92776391E-02,-0.12445811E-02, 0.00000000E+00/
     3486C     DATA (GB( 4, 2,IC),IC=1,3) /
     3487C    S 0.92776391E-02, 0.11487826E+00, 0.10000000E+01/
    36683488C
    36693489C----- INTERVAL = 1 ----- T =  237.5
    36703490C
    36713491C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    3672       DATA (GA( 5, 1,IC),IC=1,3) /
    3673      S 0.73585943E-02,-0.10847662E-02, 0.00000000E+00/
    3674       DATA (GB( 5, 1,IC),IC=1,3) /
    3675      S 0.73585943E-02, 0.10475952E+00, 0.10000000E+01/
    3676       DATA (GA( 5, 2,IC),IC=1,3) /
    3677      S 0.99806312E-02,-0.12807672E-02, 0.00000000E+00/
    3678       DATA (GB( 5, 2,IC),IC=1,3) /
    3679      S 0.99806312E-02, 0.11751113E+00, 0.10000000E+01/
     3492C     DATA (GA( 5, 1,IC),IC=1,3) /
     3493C    S 0.73585943E-02,-0.10847662E-02, 0.00000000E+00/
     3494C     DATA (GB( 5, 1,IC),IC=1,3) /
     3495C    S 0.73585943E-02, 0.10475952E+00, 0.10000000E+01/
     3496C     DATA (GA( 5, 2,IC),IC=1,3) /
     3497C    S 0.99806312E-02,-0.12807672E-02, 0.00000000E+00/
     3498C     DATA (GB( 5, 2,IC),IC=1,3) /
     3499C    S 0.99806312E-02, 0.11751113E+00, 0.10000000E+01/
    36803500C
    36813501C----- INTERVAL = 1 ----- T =  250.0
    36823502C
    36833503C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    3684       DATA (GA( 6, 1,IC),IC=1,3) /
    3685      S 0.77242818E-02,-0.11094726E-02, 0.00000000E+00/
    3686       DATA (GB( 6, 1,IC),IC=1,3) /
    3687      S 0.77242818E-02, 0.10720986E+00, 0.10000000E+01/
    3688       DATA (GA( 6, 2,IC),IC=1,3) /
    3689      S 0.10709803E-01,-0.13208251E-02, 0.00000000E+00/
    3690       DATA (GB( 6, 2,IC),IC=1,3) /
    3691      S 0.10709803E-01, 0.11951535E+00, 0.10000000E+01/
     3504C     DATA (GA( 6, 1,IC),IC=1,3) /
     3505C    S 0.77242818E-02,-0.11094726E-02, 0.00000000E+00/
     3506C     DATA (GB( 6, 1,IC),IC=1,3) /
     3507C    S 0.77242818E-02, 0.10720986E+00, 0.10000000E+01/
     3508C     DATA (GA( 6, 2,IC),IC=1,3) /
     3509C    S 0.10709803E-01,-0.13208251E-02, 0.00000000E+00/
     3510C     DATA (GB( 6, 2,IC),IC=1,3) /
     3511C    S 0.10709803E-01, 0.11951535E+00, 0.10000000E+01/
    36923512C
    36933513C----- INTERVAL = 1 ----- T =  262.5
    36943514C
    36953515C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    3696       DATA (GA( 7, 1,IC),IC=1,3) /
    3697      S 0.81472693E-02,-0.11372949E-02, 0.00000000E+00/
    3698       DATA (GB( 7, 1,IC),IC=1,3) /
    3699      S 0.81472693E-02, 0.10985370E+00, 0.10000000E+01/
    3700       DATA (GA( 7, 2,IC),IC=1,3) /
    3701      S 0.11414739E-01,-0.13619034E-02, 0.00000000E+00/
    3702       DATA (GB( 7, 2,IC),IC=1,3) /
    3703      S 0.11414739E-01, 0.12069945E+00, 0.10000000E+01/
     3516C     DATA (GA( 7, 1,IC),IC=1,3) /
     3517C    S 0.81472693E-02,-0.11372949E-02, 0.00000000E+00/
     3518C     DATA (GB( 7, 1,IC),IC=1,3) /
     3519C    S 0.81472693E-02, 0.10985370E+00, 0.10000000E+01/
     3520C     DATA (GA( 7, 2,IC),IC=1,3) /
     3521C    S 0.11414739E-01,-0.13619034E-02, 0.00000000E+00/
     3522C     DATA (GB( 7, 2,IC),IC=1,3) /
     3523C    S 0.11414739E-01, 0.12069945E+00, 0.10000000E+01/
    37043524C
    37053525C----- INTERVAL = 1 ----- T =  275.0
    37063526C
    37073527C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    3708       DATA (GA( 8, 1,IC),IC=1,3) /
    3709      S 0.86227527E-02,-0.11687683E-02, 0.00000000E+00/
    3710       DATA (GB( 8, 1,IC),IC=1,3) /
    3711      S 0.86227527E-02, 0.11257633E+00, 0.10000000E+01/
    3712       DATA (GA( 8, 2,IC),IC=1,3) /
    3713      S 0.12058772E-01,-0.14014165E-02, 0.00000000E+00/
    3714       DATA (GB( 8, 2,IC),IC=1,3) /
    3715      S 0.12058772E-01, 0.12108524E+00, 0.10000000E+01/
     3528C     DATA (GA( 8, 1,IC),IC=1,3) /
     3529C    S 0.86227527E-02,-0.11687683E-02, 0.00000000E+00/
     3530C     DATA (GB( 8, 1,IC),IC=1,3) /
     3531C    S 0.86227527E-02, 0.11257633E+00, 0.10000000E+01/
     3532C     DATA (GA( 8, 2,IC),IC=1,3) /
     3533C    S 0.12058772E-01,-0.14014165E-02, 0.00000000E+00/
     3534C     DATA (GB( 8, 2,IC),IC=1,3) /
     3535C    S 0.12058772E-01, 0.12108524E+00, 0.10000000E+01/
    37163536C
    37173537C----- INTERVAL = 1 ----- T =  287.5
    37183538C
    37193539C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    3720       DATA (GA( 9, 1,IC),IC=1,3) /
    3721      S 0.91396814E-02,-0.12038314E-02, 0.00000000E+00/
    3722       DATA (GB( 9, 1,IC),IC=1,3) /
    3723      S 0.91396814E-02, 0.11522980E+00, 0.10000000E+01/
    3724       DATA (GA( 9, 2,IC),IC=1,3) /
    3725      S 0.12623992E-01,-0.14378639E-02, 0.00000000E+00/
    3726       DATA (GB( 9, 2,IC),IC=1,3) /
    3727      S 0.12623992E-01, 0.12084229E+00, 0.10000000E+01/
     3540C     DATA (GA( 9, 1,IC),IC=1,3) /
     3541C    S 0.91396814E-02,-0.12038314E-02, 0.00000000E+00/
     3542C     DATA (GB( 9, 1,IC),IC=1,3) /
     3543C    S 0.91396814E-02, 0.11522980E+00, 0.10000000E+01/
     3544C     DATA (GA( 9, 2,IC),IC=1,3) /
     3545C    S 0.12623992E-01,-0.14378639E-02, 0.00000000E+00/
     3546C     DATA (GB( 9, 2,IC),IC=1,3) /
     3547C    S 0.12623992E-01, 0.12084229E+00, 0.10000000E+01/
    37283548C
    37293549C----- INTERVAL = 1 ----- T =  300.0
    37303550C
    37313551C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    3732       DATA (GA(10, 1,IC),IC=1,3) /
    3733      S 0.96825438E-02,-0.12418367E-02, 0.00000000E+00/
    3734       DATA (GB(10, 1,IC),IC=1,3) /
    3735      S 0.96825438E-02, 0.11766343E+00, 0.10000000E+01/
    3736       DATA (GA(10, 2,IC),IC=1,3) /
    3737      S 0.13108146E-01,-0.14708488E-02, 0.00000000E+00/
    3738       DATA (GB(10, 2,IC),IC=1,3) /
    3739      S 0.13108146E-01, 0.12019005E+00, 0.10000000E+01/
     3552C     DATA (GA(10, 1,IC),IC=1,3) /
     3553C    S 0.96825438E-02,-0.12418367E-02, 0.00000000E+00/
     3554C     DATA (GB(10, 1,IC),IC=1,3) /
     3555C    S 0.96825438E-02, 0.11766343E+00, 0.10000000E+01/
     3556C     DATA (GA(10, 2,IC),IC=1,3) /
     3557C    S 0.13108146E-01,-0.14708488E-02, 0.00000000E+00/
     3558C     DATA (GB(10, 2,IC),IC=1,3) /
     3559C    S 0.13108146E-01, 0.12019005E+00, 0.10000000E+01/
    37403560C
    37413561C----- INTERVAL = 1 ----- T =  312.5
    37423562C
    37433563C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    3744       DATA (GA(11, 1,IC),IC=1,3) /
    3745      S 0.10233955E-01,-0.12817135E-02, 0.00000000E+00/
    3746       DATA (GB(11, 1,IC),IC=1,3) /
    3747      S 0.10233955E-01, 0.11975320E+00, 0.10000000E+01/
    3748       DATA (GA(11, 2,IC),IC=1,3) /
    3749      S 0.13518390E-01,-0.15006791E-02, 0.00000000E+00/
    3750       DATA (GB(11, 2,IC),IC=1,3) /
    3751      S 0.13518390E-01, 0.11932684E+00, 0.10000000E+01/
     3564C     DATA (GA(11, 1,IC),IC=1,3) /
     3565C    S 0.10233955E-01,-0.12817135E-02, 0.00000000E+00/
     3566C     DATA (GB(11, 1,IC),IC=1,3) /
     3567C    S 0.10233955E-01, 0.11975320E+00, 0.10000000E+01/
     3568C     DATA (GA(11, 2,IC),IC=1,3) /
     3569C    S 0.13518390E-01,-0.15006791E-02, 0.00000000E+00/
     3570C     DATA (GB(11, 2,IC),IC=1,3) /
     3571C    S 0.13518390E-01, 0.11932684E+00, 0.10000000E+01/
    37523572C
    37533573C
    … …  
    37643584C
    37653585C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3766       DATA (GA( 1, 3,IC),IC=1,3) /
    3767      S 0.11644593E+01, 0.41243390E+00, 0.00000000E+00/
    3768       DATA (GB( 1, 3,IC),IC=1,3) /
    3769      S 0.11644593E+01, 0.10346097E+01, 0.10000000E+01/
    3770       DATA (GA( 1, 4,IC),IC=1,3) /
    3771      S 0.12006968E+01, 0.48318936E+00, 0.00000000E+00/
    3772       DATA (GB( 1, 4,IC),IC=1,3) /
    3773      S 0.12006968E+01, 0.10626130E+01, 0.10000000E+01/
     3586C     DATA (GA( 1, 3,IC),IC=1,3) /
     3587C    S 0.11644593E+01, 0.41243390E+00, 0.00000000E+00/
     3588C     DATA (GB( 1, 3,IC),IC=1,3) /
     3589C    S 0.11644593E+01, 0.10346097E+01, 0.10000000E+01/
     3590C     DATA (GA( 1, 4,IC),IC=1,3) /
     3591C    S 0.12006968E+01, 0.48318936E+00, 0.00000000E+00/
     3592C     DATA (GB( 1, 4,IC),IC=1,3) /
     3593C    S 0.12006968E+01, 0.10626130E+01, 0.10000000E+01/
    37743594C
    37753595C----- INTERVAL = 2 ----- T =  200.0
    37763596C
    37773597C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3778       DATA (GA( 2, 3,IC),IC=1,3) /
    3779      S 0.11747203E+01, 0.43407282E+00, 0.00000000E+00/
    3780       DATA (GB( 2, 3,IC),IC=1,3) /
    3781      S 0.11747203E+01, 0.10433655E+01, 0.10000000E+01/
    3782       DATA (GA( 2, 4,IC),IC=1,3) /
    3783      S 0.12108196E+01, 0.50501827E+00, 0.00000000E+00/
    3784       DATA (GB( 2, 4,IC),IC=1,3) /
    3785      S 0.12108196E+01, 0.10716026E+01, 0.10000000E+01/
     3598C     DATA (GA( 2, 3,IC),IC=1,3) /
     3599C    S 0.11747203E+01, 0.43407282E+00, 0.00000000E+00/
     3600C     DATA (GB( 2, 3,IC),IC=1,3) /
     3601C    S 0.11747203E+01, 0.10433655E+01, 0.10000000E+01/
     3602C     DATA (GA( 2, 4,IC),IC=1,3) /
     3603C    S 0.12108196E+01, 0.50501827E+00, 0.00000000E+00/
     3604C     DATA (GB( 2, 4,IC),IC=1,3) /
     3605C    S 0.12108196E+01, 0.10716026E+01, 0.10000000E+01/
    37863606C
    37873607C----- INTERVAL = 2 ----- T =  212.5
    37883608C
    37893609C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3790       DATA (GA( 3, 3,IC),IC=1,3) /
    3791      S 0.11837872E+01, 0.45331413E+00, 0.00000000E+00/
    3792       DATA (GB( 3, 3,IC),IC=1,3) /
    3793      S 0.11837872E+01, 0.10511933E+01, 0.10000000E+01/
    3794       DATA (GA( 3, 4,IC),IC=1,3) /
    3795      S 0.12196717E+01, 0.52409502E+00, 0.00000000E+00/
    3796       DATA (GB( 3, 4,IC),IC=1,3) /
    3797      S 0.12196717E+01, 0.10795108E+01, 0.10000000E+01/
     3610C     DATA (GA( 3, 3,IC),IC=1,3) /
     3611C    S 0.11837872E+01, 0.45331413E+00, 0.00000000E+00/
     3612C     DATA (GB( 3, 3,IC),IC=1,3) /
     3613C    S 0.11837872E+01, 0.10511933E+01, 0.10000000E+01/
     3614C     DATA (GA( 3, 4,IC),IC=1,3) /
     3615C    S 0.12196717E+01, 0.52409502E+00, 0.00000000E+00/
     3616C     DATA (GB( 3, 4,IC),IC=1,3) /
     3617C    S 0.12196717E+01, 0.10795108E+01, 0.10000000E+01/
    37983618C
    37993619C----- INTERVAL = 2 ----- T =  225.0
    38003620C
    38013621C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3802       DATA (GA( 4, 3,IC),IC=1,3) /
    3803      S 0.11918561E+01, 0.47048604E+00, 0.00000000E+00/
    3804       DATA (GB( 4, 3,IC),IC=1,3) /
    3805      S 0.11918561E+01, 0.10582150E+01, 0.10000000E+01/
    3806       DATA (GA( 4, 4,IC),IC=1,3) /
    3807      S 0.12274493E+01, 0.54085277E+00, 0.00000000E+00/
    3808       DATA (GB( 4, 4,IC),IC=1,3) /
    3809      S 0.12274493E+01, 0.10865006E+01, 0.10000000E+01/
     3622C     DATA (GA( 4, 3,IC),IC=1,3) /
     3623C    S 0.11918561E+01, 0.47048604E+00, 0.00000000E+00/
     3624C     DATA (GB( 4, 3,IC),IC=1,3) /
     3625C    S 0.11918561E+01, 0.10582150E+01, 0.10000000E+01/
     3626C     DATA (GA( 4, 4,IC),IC=1,3) /
     3627C    S 0.12274493E+01, 0.54085277E+00, 0.00000000E+00/
     3628C     DATA (GB( 4, 4,IC),IC=1,3) /
     3629C    S 0.12274493E+01, 0.10865006E+01, 0.10000000E+01/
    38103630C
    38113631C----- INTERVAL = 2 ----- T =  237.5
    38123632C
    38133633C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3814       DATA (GA( 5, 3,IC),IC=1,3) /
    3815      S 0.11990757E+01, 0.48586286E+00, 0.00000000E+00/
    3816       DATA (GB( 5, 3,IC),IC=1,3) /
    3817      S 0.11990757E+01, 0.10645317E+01, 0.10000000E+01/
    3818       DATA (GA( 5, 4,IC),IC=1,3) /
    3819      S 0.12343189E+01, 0.55565422E+00, 0.00000000E+00/
    3820       DATA (GB( 5, 4,IC),IC=1,3) /
    3821      S 0.12343189E+01, 0.10927103E+01, 0.10000000E+01/
     3634C     DATA (GA( 5, 3,IC),IC=1,3) /
     3635C    S 0.11990757E+01, 0.48586286E+00, 0.00000000E+00/
     3636C     DATA (GB( 5, 3,IC),IC=1,3) /
     3637C    S 0.11990757E+01, 0.10645317E+01, 0.10000000E+01/
     3638C     DATA (GA( 5, 4,IC),IC=1,3) /
     3639C    S 0.12343189E+01, 0.55565422E+00, 0.00000000E+00/
     3640C     DATA (GB( 5, 4,IC),IC=1,3) /
     3641C    S 0.12343189E+01, 0.10927103E+01, 0.10000000E+01/
    38223642C
    38233643C----- INTERVAL = 2 ----- T =  250.0
    38243644C
    38253645C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3826       DATA (GA( 6, 3,IC),IC=1,3) /
    3827      S 0.12055643E+01, 0.49968044E+00, 0.00000000E+00/
    3828       DATA (GB( 6, 3,IC),IC=1,3) /
    3829      S 0.12055643E+01, 0.10702313E+01, 0.10000000E+01/
    3830       DATA (GA( 6, 4,IC),IC=1,3) /
    3831      S 0.12404147E+01, 0.56878618E+00, 0.00000000E+00/
    3832       DATA (GB( 6, 4,IC),IC=1,3) /
    3833      S 0.12404147E+01, 0.10982489E+01, 0.10000000E+01/
     3646C     DATA (GA( 6, 3,IC),IC=1,3) /
     3647C    S 0.12055643E+01, 0.49968044E+00, 0.00000000E+00/
     3648C     DATA (GB( 6, 3,IC),IC=1,3) /
     3649C    S 0.12055643E+01, 0.10702313E+01, 0.10000000E+01/
     3650C     DATA (GA( 6, 4,IC),IC=1,3) /
     3651C    S 0.12404147E+01, 0.56878618E+00, 0.00000000E+00/
     3652C     DATA (GB( 6, 4,IC),IC=1,3) /
     3653C    S 0.12404147E+01, 0.10982489E+01, 0.10000000E+01/
    38343654C
    38353655C----- INTERVAL = 2 ----- T =  262.5
    38363656C
    38373657C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3838       DATA (GA( 7, 3,IC),IC=1,3) /
    3839      S 0.12114186E+01, 0.51214132E+00, 0.00000000E+00/
    3840       DATA (GB( 7, 3,IC),IC=1,3) /
    3841      S 0.12114186E+01, 0.10753907E+01, 0.10000000E+01/
    3842       DATA (GA( 7, 4,IC),IC=1,3) /
    3843      S 0.12458431E+01, 0.58047395E+00, 0.00000000E+00/
    3844       DATA (GB( 7, 4,IC),IC=1,3) /
    3845      S 0.12458431E+01, 0.11032019E+01, 0.10000000E+01/
     3658C     DATA (GA( 7, 3,IC),IC=1,3) /
     3659C    S 0.12114186E+01, 0.51214132E+00, 0.00000000E+00/
     3660C     DATA (GB( 7, 3,IC),IC=1,3) /
     3661C    S 0.12114186E+01, 0.10753907E+01, 0.10000000E+01/
     3662C     DATA (GA( 7, 4,IC),IC=1,3) /
     3663C    S 0.12458431E+01, 0.58047395E+00, 0.00000000E+00/
     3664C     DATA (GB( 7, 4,IC),IC=1,3) /
     3665C    S 0.12458431E+01, 0.11032019E+01, 0.10000000E+01/
    38463666C
    38473667C----- INTERVAL = 2 ----- T =  275.0
    38483668C
    38493669C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3850       DATA (GA( 8, 3,IC),IC=1,3) /
    3851      S 0.12167192E+01, 0.52341830E+00, 0.00000000E+00/
    3852       DATA (GB( 8, 3,IC),IC=1,3) /
    3853      S 0.12167192E+01, 0.10800762E+01, 0.10000000E+01/
    3854       DATA (GA( 8, 4,IC),IC=1,3) /
    3855      S 0.12506907E+01, 0.59089894E+00, 0.00000000E+00/
    3856       DATA (GB( 8, 4,IC),IC=1,3) /
    3857      S 0.12506907E+01, 0.11076379E+01, 0.10000000E+01/
     3670C     DATA (GA( 8, 3,IC),IC=1,3) /
     3671C    S 0.12167192E+01, 0.52341830E+00, 0.00000000E+00/
     3672C     DATA (GB( 8, 3,IC),IC=1,3) /
     3673C    S 0.12167192E+01, 0.10800762E+01, 0.10000000E+01/
     3674C     DATA (GA( 8, 4,IC),IC=1,3) /
     3675C    S 0.12506907E+01, 0.59089894E+00, 0.00000000E+00/
     3676C     DATA (GB( 8, 4,IC),IC=1,3) /
     3677C    S 0.12506907E+01, 0.11076379E+01, 0.10000000E+01/
    38583678C
    38593679C----- INTERVAL = 2 ----- T =  287.5
    38603680C
    38613681C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3862       DATA (GA( 9, 3,IC),IC=1,3) /
    3863      S 0.12215344E+01, 0.53365803E+00, 0.00000000E+00/
    3864       DATA (GB( 9, 3,IC),IC=1,3) /
    3865      S 0.12215344E+01, 0.10843446E+01, 0.10000000E+01/
    3866       DATA (GA( 9, 4,IC),IC=1,3) /
    3867      S 0.12550299E+01, 0.60021475E+00, 0.00000000E+00/
    3868       DATA (GB( 9, 4,IC),IC=1,3) /
    3869      S 0.12550299E+01, 0.11116160E+01, 0.10000000E+01/
     3682C     DATA (GA( 9, 3,IC),IC=1,3) /
     3683C    S 0.12215344E+01, 0.53365803E+00, 0.00000000E+00/
     3684C     DATA (GB( 9, 3,IC),IC=1,3) /
     3685C    S 0.12215344E+01, 0.10843446E+01, 0.10000000E+01/
     3686C     DATA (GA( 9, 4,IC),IC=1,3) /
     3687C    S 0.12550299E+01, 0.60021475E+00, 0.00000000E+00/
     3688C     DATA (GB( 9, 4,IC),IC=1,3) /
     3689C    S 0.12550299E+01, 0.11116160E+01, 0.10000000E+01/
    38703690C
    38713691C----- INTERVAL = 2 ----- T =  300.0
    38723692C
    38733693C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3874       DATA (GA(10, 3,IC),IC=1,3) /
    3875      S 0.12259226E+01, 0.54298448E+00, 0.00000000E+00/
    3876       DATA (GB(10, 3,IC),IC=1,3) /
    3877      S 0.12259226E+01, 0.10882439E+01, 0.10000000E+01/
    3878       DATA (GA(10, 4,IC),IC=1,3) /
    3879      S 0.12589256E+01, 0.60856112E+00, 0.00000000E+00/
    3880       DATA (GB(10, 4,IC),IC=1,3) /
    3881      S 0.12589256E+01, 0.11151910E+01, 0.10000000E+01/
     3694C     DATA (GA(10, 3,IC),IC=1,3) /
     3695C    S 0.12259226E+01, 0.54298448E+00, 0.00000000E+00/
     3696C     DATA (GB(10, 3,IC),IC=1,3) /
     3697C    S 0.12259226E+01, 0.10882439E+01, 0.10000000E+01/
     3698C     DATA (GA(10, 4,IC),IC=1,3) /
     3699C    S 0.12589256E+01, 0.60856112E+00, 0.00000000E+00/
     3700C     DATA (GB(10, 4,IC),IC=1,3) /
     3701C    S 0.12589256E+01, 0.11151910E+01, 0.10000000E+01/
    38823702C
    38833703C----- INTERVAL = 2 ----- T =  312.5
    38843704C
    38853705C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3886       DATA (GA(11, 3,IC),IC=1,3) /
    3887      S 0.12299344E+01, 0.55150227E+00, 0.00000000E+00/
    3888       DATA (GB(11, 3,IC),IC=1,3) /
    3889      S 0.12299344E+01, 0.10918144E+01, 0.10000000E+01/
    3890       DATA (GA(11, 4,IC),IC=1,3) /
    3891      S 0.12624402E+01, 0.61607594E+00, 0.00000000E+00/
    3892       DATA (GB(11, 4,IC),IC=1,3) /
    3893      S 0.12624402E+01, 0.11184188E+01, 0.10000000E+01/
     3706C     DATA (GA(11, 3,IC),IC=1,3) /
     3707C    S 0.12299344E+01, 0.55150227E+00, 0.00000000E+00/
     3708C     DATA (GB(11, 3,IC),IC=1,3) /
     3709C    S 0.12299344E+01, 0.10918144E+01, 0.10000000E+01/
     3710C     DATA (GA(11, 4,IC),IC=1,3) /
     3711C    S 0.12624402E+01, 0.61607594E+00, 0.00000000E+00/
     3712C     DATA (GB(11, 4,IC),IC=1,3) /
     3713C    S 0.12624402E+01, 0.11184188E+01, 0.10000000E+01/
    38943714C
    38953715C
    … …  
    39103730C
    39113731C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3912       DATA (GA( 1, 7,IC),IC=1,3) /
    3913      S 0.10192131E+02, 0.80737799E+01, 0.00000000E+00/
    3914       DATA (GB( 1, 7,IC),IC=1,3) /
    3915      S 0.10192131E+02, 0.82623280E+01, 0.10000000E+01/
    3916       DATA (GA( 1, 8,IC),IC=1,3) /
    3917      S 0.92439050E+01, 0.77425778E+01, 0.00000000E+00/
    3918       DATA (GB( 1, 8,IC),IC=1,3) /
    3919      S 0.92439050E+01, 0.79342219E+01, 0.10000000E+01/
     3732C     DATA (GA( 1, 7,IC),IC=1,3) /
     3733C    S 0.10192131E+02, 0.80737799E+01, 0.00000000E+00/
     3734C     DATA (GB( 1, 7,IC),IC=1,3) /
     3735C    S 0.10192131E+02, 0.82623280E+01, 0.10000000E+01/
     3736C     DATA (GA( 1, 8,IC),IC=1,3) /
     3737C    S 0.92439050E+01, 0.77425778E+01, 0.00000000E+00/
     3738C     DATA (GB( 1, 8,IC),IC=1,3) /
     3739C    S 0.92439050E+01, 0.79342219E+01, 0.10000000E+01/
    39203740C
    39213741C----- INTERVAL = 3 ----- T =  200.0
    39223742C
    39233743C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3924       DATA (GA( 2, 7,IC),IC=1,3) /
    3925      S 0.97258602E+01, 0.79171158E+01, 0.00000000E+00/
    3926       DATA (GB( 2, 7,IC),IC=1,3) /
    3927      S 0.97258602E+01, 0.81072291E+01, 0.10000000E+01/
    3928       DATA (GA( 2, 8,IC),IC=1,3) /
    3929      S 0.87567422E+01, 0.75443460E+01, 0.00000000E+00/
    3930       DATA (GB( 2, 8,IC),IC=1,3) /
    3931      S 0.87567422E+01, 0.77373458E+01, 0.10000000E+01/
     3744C     DATA (GA( 2, 7,IC),IC=1,3) /
     3745C    S 0.97258602E+01, 0.79171158E+01, 0.00000000E+00/
     3746C     DATA (GB( 2, 7,IC),IC=1,3) /
     3747C    S 0.97258602E+01, 0.81072291E+01, 0.10000000E+01/
     3748C     DATA (GA( 2, 8,IC),IC=1,3) /
     3749C    S 0.87567422E+01, 0.75443460E+01, 0.00000000E+00/
     3750C     DATA (GB( 2, 8,IC),IC=1,3) /
     3751C    S 0.87567422E+01, 0.77373458E+01, 0.10000000E+01/
    39323752C
    39333753C----- INTERVAL = 3 ----- T =  212.5
    39343754C
    39353755C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3936       DATA (GA( 3, 7,IC),IC=1,3) /
    3937      S 0.92992890E+01, 0.77609605E+01, 0.00000000E+00/
    3938       DATA (GB( 3, 7,IC),IC=1,3) /
    3939      S 0.92992890E+01, 0.79523834E+01, 0.10000000E+01/
    3940       DATA (GA( 3, 8,IC),IC=1,3) /
    3941      S 0.83270144E+01, 0.73526151E+01, 0.00000000E+00/
    3942       DATA (GB( 3, 8,IC),IC=1,3) /
    3943      S 0.83270144E+01, 0.75467334E+01, 0.10000000E+01/
     3756C     DATA (GA( 3, 7,IC),IC=1,3) /
     3757C    S 0.92992890E+01, 0.77609605E+01, 0.00000000E+00/
     3758C     DATA (GB( 3, 7,IC),IC=1,3) /
     3759C    S 0.92992890E+01, 0.79523834E+01, 0.10000000E+01/
     3760C     DATA (GA( 3, 8,IC),IC=1,3) /
     3761C    S 0.83270144E+01, 0.73526151E+01, 0.00000000E+00/
     3762C     DATA (GB( 3, 8,IC),IC=1,3) /
     3763C    S 0.83270144E+01, 0.75467334E+01, 0.10000000E+01/
    39443764C
    39453765C----- INTERVAL = 3 ----- T =  225.0
    39463766C
    39473767C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3948       DATA (GA( 4, 7,IC),IC=1,3) /
    3949      S 0.89154021E+01, 0.76087371E+01, 0.00000000E+00/
    3950       DATA (GB( 4, 7,IC),IC=1,3) /
    3951      S 0.89154021E+01, 0.78012527E+01, 0.10000000E+01/
    3952       DATA (GA( 4, 8,IC),IC=1,3) /
    3953      S 0.79528337E+01, 0.71711188E+01, 0.00000000E+00/
    3954       DATA (GB( 4, 8,IC),IC=1,3) /
    3955      S 0.79528337E+01, 0.73661786E+01, 0.10000000E+01/
     3768C     DATA (GA( 4, 7,IC),IC=1,3) /
     3769C    S 0.89154021E+01, 0.76087371E+01, 0.00000000E+00/
     3770C     DATA (GB( 4, 7,IC),IC=1,3) /
     3771C    S 0.89154021E+01, 0.78012527E+01, 0.10000000E+01/
     3772C     DATA (GA( 4, 8,IC),IC=1,3) /
     3773C    S 0.79528337E+01, 0.71711188E+01, 0.00000000E+00/
     3774C     DATA (GB( 4, 8,IC),IC=1,3) /
     3775C    S 0.79528337E+01, 0.73661786E+01, 0.10000000E+01/
    39563776C
    39573777C----- INTERVAL = 3 ----- T =  237.5
    39583778C
    39593779C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3960       DATA (GA( 5, 7,IC),IC=1,3) /
    3961      S 0.85730084E+01, 0.74627112E+01, 0.00000000E+00/
    3962       DATA (GB( 5, 7,IC),IC=1,3) /
    3963      S 0.85730084E+01, 0.76561458E+01, 0.10000000E+01/
    3964       DATA (GA( 5, 8,IC),IC=1,3) /
    3965      S 0.76286839E+01, 0.70015571E+01, 0.00000000E+00/
    3966       DATA (GB( 5, 8,IC),IC=1,3) /
    3967      S 0.76286839E+01, 0.71974319E+01, 0.10000000E+01/
     3780C     DATA (GA( 5, 7,IC),IC=1,3) /
     3781C    S 0.85730084E+01, 0.74627112E+01, 0.00000000E+00/
     3782C     DATA (GB( 5, 7,IC),IC=1,3) /
     3783C    S 0.85730084E+01, 0.76561458E+01, 0.10000000E+01/
     3784C     DATA (GA( 5, 8,IC),IC=1,3) /
     3785C    S 0.76286839E+01, 0.70015571E+01, 0.00000000E+00/
     3786C     DATA (GB( 5, 8,IC),IC=1,3) /
     3787C    S 0.76286839E+01, 0.71974319E+01, 0.10000000E+01/
    39683788C
    39693789C----- INTERVAL = 3 ----- T =  250.0
    39703790C
    39713791C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3972       DATA (GA( 6, 7,IC),IC=1,3) /
    3973      S 0.82685838E+01, 0.73239981E+01, 0.00000000E+00/
    3974       DATA (GB( 6, 7,IC),IC=1,3) /
    3975      S 0.82685838E+01, 0.75182174E+01, 0.10000000E+01/
    3976       DATA (GA( 6, 8,IC),IC=1,3) /
    3977      S 0.73477879E+01, 0.68442532E+01, 0.00000000E+00/
    3978       DATA (GB( 6, 8,IC),IC=1,3) /
    3979      S 0.73477879E+01, 0.70408543E+01, 0.10000000E+01/
     3792C     DATA (GA( 6, 7,IC),IC=1,3) /
     3793C    S 0.82685838E+01, 0.73239981E+01, 0.00000000E+00/
     3794C     DATA (GB( 6, 7,IC),IC=1,3) /
     3795C    S 0.82685838E+01, 0.75182174E+01, 0.10000000E+01/
     3796C     DATA (GA( 6, 8,IC),IC=1,3) /
     3797C    S 0.73477879E+01, 0.68442532E+01, 0.00000000E+00/
     3798C     DATA (GB( 6, 8,IC),IC=1,3) /
     3799C    S 0.73477879E+01, 0.70408543E+01, 0.10000000E+01/
    39803800C
    39813801C----- INTERVAL = 3 ----- T =  262.5
    39823802C
    39833803C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3984       DATA (GA( 7, 7,IC),IC=1,3) /
    3985      S 0.79978921E+01, 0.71929934E+01, 0.00000000E+00/
    3986       DATA (GB( 7, 7,IC),IC=1,3) /
    3987      S 0.79978921E+01, 0.73878952E+01, 0.10000000E+01/
    3988       DATA (GA( 7, 8,IC),IC=1,3) /
    3989      S 0.71035818E+01, 0.66987996E+01, 0.00000000E+00/
    3990       DATA (GB( 7, 8,IC),IC=1,3) /
    3991      S 0.71035818E+01, 0.68960649E+01, 0.10000000E+01/
     3804C     DATA (GA( 7, 7,IC),IC=1,3) /
     3805C    S 0.79978921E+01, 0.71929934E+01, 0.00000000E+00/
     3806C     DATA (GB( 7, 7,IC),IC=1,3) /
     3807C    S 0.79978921E+01, 0.73878952E+01, 0.10000000E+01/
     3808C     DATA (GA( 7, 8,IC),IC=1,3) /
     3809C    S 0.71035818E+01, 0.66987996E+01, 0.00000000E+00/
     3810C     DATA (GB( 7, 8,IC),IC=1,3) /
     3811C    S 0.71035818E+01, 0.68960649E+01, 0.10000000E+01/
    39923812C
    39933813C----- INTERVAL = 3 ----- T =  275.0
    39943814C
    39953815C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    3996       DATA (GA( 8, 7,IC),IC=1,3) /
    3997      S 0.77568055E+01, 0.70697065E+01, 0.00000000E+00/
    3998       DATA (GB( 8, 7,IC),IC=1,3) /
    3999      S 0.77568055E+01, 0.72652133E+01, 0.10000000E+01/
    4000       DATA (GA( 8, 8,IC),IC=1,3) /
    4001      S 0.68903312E+01, 0.65644820E+01, 0.00000000E+00/
    4002       DATA (GB( 8, 8,IC),IC=1,3) /
    4003      S 0.68903312E+01, 0.67623672E+01, 0.10000000E+01/
     3816C     DATA (GA( 8, 7,IC),IC=1,3) /
     3817C    S 0.77568055E+01, 0.70697065E+01, 0.00000000E+00/
     3818C     DATA (GB( 8, 7,IC),IC=1,3) /
     3819C    S 0.77568055E+01, 0.72652133E+01, 0.10000000E+01/
     3820C     DATA (GA( 8, 8,IC),IC=1,3) /
     3821C    S 0.68903312E+01, 0.65644820E+01, 0.00000000E+00/
     3822C     DATA (GB( 8, 8,IC),IC=1,3) /
     3823C    S 0.68903312E+01, 0.67623672E+01, 0.10000000E+01/
    40043824C
    40053825C----- INTERVAL = 3 ----- T =  287.5
    40063826C
    40073827C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    4008       DATA (GA( 9, 7,IC),IC=1,3) /
    4009      S 0.75416266E+01, 0.69539626E+01, 0.00000000E+00/
    4010       DATA (GB( 9, 7,IC),IC=1,3) /
    4011      S 0.75416266E+01, 0.71500151E+01, 0.10000000E+01/
    4012       DATA (GA( 9, 8,IC),IC=1,3) /
    4013      S 0.67032875E+01, 0.64405267E+01, 0.00000000E+00/
    4014       DATA (GB( 9, 8,IC),IC=1,3) /
    4015      S 0.67032875E+01, 0.66389989E+01, 0.10000000E+01/
     3828C     DATA (GA( 9, 7,IC),IC=1,3) /
     3829C    S 0.75416266E+01, 0.69539626E+01, 0.00000000E+00/
     3830C     DATA (GB( 9, 7,IC),IC=1,3) /
     3831C    S 0.75416266E+01, 0.71500151E+01, 0.10000000E+01/
     3832C     DATA (GA( 9, 8,IC),IC=1,3) /
     3833C    S 0.67032875E+01, 0.64405267E+01, 0.00000000E+00/
     3834C     DATA (GB( 9, 8,IC),IC=1,3) /
     3835C    S 0.67032875E+01, 0.66389989E+01, 0.10000000E+01/
    40163836C
    40173837C----- INTERVAL = 3 ----- T =  300.0
    40183838C
    40193839C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    4020       DATA (GA(10, 7,IC),IC=1,3) /
    4021      S 0.73491694E+01, 0.68455144E+01, 0.00000000E+00/
    4022       DATA (GB(10, 7,IC),IC=1,3) /
    4023      S 0.73491694E+01, 0.70420667E+01, 0.10000000E+01/
    4024       DATA (GA(10, 8,IC),IC=1,3) /
    4025      S 0.65386461E+01, 0.63262376E+01, 0.00000000E+00/
    4026       DATA (GB(10, 8,IC),IC=1,3) /
    4027      S 0.65386461E+01, 0.65252707E+01, 0.10000000E+01/
     3840C     DATA (GA(10, 7,IC),IC=1,3) /
     3841C    S 0.73491694E+01, 0.68455144E+01, 0.00000000E+00/
     3842C     DATA (GB(10, 7,IC),IC=1,3) /
     3843C    S 0.73491694E+01, 0.70420667E+01, 0.10000000E+01/
     3844C     DATA (GA(10, 8,IC),IC=1,3) /
     3845C    S 0.65386461E+01, 0.63262376E+01, 0.00000000E+00/
     3846C     DATA (GB(10, 8,IC),IC=1,3) /
     3847C    S 0.65386461E+01, 0.65252707E+01, 0.10000000E+01/
    40283848C
    40293849C----- INTERVAL = 3 ----- T =  312.5
    40303850C
    40313851C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    4032       DATA (GA(11, 7,IC),IC=1,3) /
    4033      S 0.71767400E+01, 0.67441020E+01, 0.00000000E+00/
    4034       DATA (GB(11, 7,IC),IC=1,3) /
    4035      S 0.71767400E+01, 0.69411177E+01, 0.10000000E+01/
    4036       DATA (GA(11, 8,IC),IC=1,3) /
    4037      S 0.63934377E+01, 0.62210701E+01, 0.00000000E+00/
    4038       DATA (GB(11, 8,IC),IC=1,3) /
    4039      S 0.63934377E+01, 0.64206412E+01, 0.10000000E+01/
     3852C     DATA (GA(11, 7,IC),IC=1,3) /
     3853C    S 0.71767400E+01, 0.67441020E+01, 0.00000000E+00/
     3854C     DATA (GB(11, 7,IC),IC=1,3) /
     3855C    S 0.71767400E+01, 0.69411177E+01, 0.10000000E+01/
     3856C     DATA (GA(11, 8,IC),IC=1,3) /
     3857C    S 0.63934377E+01, 0.62210701E+01, 0.00000000E+00/
     3858C     DATA (GB(11, 8,IC),IC=1,3) /
     3859C    S 0.63934377E+01, 0.64206412E+01, 0.10000000E+01/
    40403860C
    40413861C
    … …  
    40473867C
    40483868C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    4049       DATA (GA( 1, 9,IC),IC=1,3) /
    4050      S 0.24870635E+02, 0.10542131E+02, 0.00000000E+00/
    4051       DATA (GB( 1, 9,IC),IC=1,3) /
    4052      S 0.24870635E+02, 0.10656640E+02, 0.10000000E+01/
    4053       DATA (GA( 1,10,IC),IC=1,3) /
    4054      S 0.24586283E+02, 0.10490353E+02, 0.00000000E+00/
    4055       DATA (GB( 1,10,IC),IC=1,3) /
    4056      S 0.24586283E+02, 0.10605856E+02, 0.10000000E+01/
     3869C     DATA (GA( 1, 9,IC),IC=1,3) /
     3870C    S 0.24870635E+02, 0.10542131E+02, 0.00000000E+00/
     3871C     DATA (GB( 1, 9,IC),IC=1,3) /
     3872C    S 0.24870635E+02, 0.10656640E+02, 0.10000000E+01/
     3873C     DATA (GA( 1,10,IC),IC=1,3) /
     3874C    S 0.24586283E+02, 0.10490353E+02, 0.00000000E+00/
     3875C     DATA (GB( 1,10,IC),IC=1,3) /
     3876C    S 0.24586283E+02, 0.10605856E+02, 0.10000000E+01/
    40573877C
    40583878C----- INTERVAL = 4 ----- T =  200.0
    40593879C
    40603880C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    4061       DATA (GA( 2, 9,IC),IC=1,3) /
    4062      S 0.24725591E+02, 0.10515895E+02, 0.00000000E+00/
    4063       DATA (GB( 2, 9,IC),IC=1,3) /
    4064      S 0.24725591E+02, 0.10630910E+02, 0.10000000E+01/
    4065       DATA (GA( 2,10,IC),IC=1,3) /
    4066      S 0.24441465E+02, 0.10463512E+02, 0.00000000E+00/
    4067       DATA (GB( 2,10,IC),IC=1,3) /
    4068      S 0.24441465E+02, 0.10579514E+02, 0.10000000E+01/
     3881C     DATA (GA( 2, 9,IC),IC=1,3) /
     3882C    S 0.24725591E+02, 0.10515895E+02, 0.00000000E+00/
     3883C     DATA (GB( 2, 9,IC),IC=1,3) /
     3884C    S 0.24725591E+02, 0.10630910E+02, 0.10000000E+01/
     3885C     DATA (GA( 2,10,IC),IC=1,3) /
     3886C    S 0.24441465E+02, 0.10463512E+02, 0.00000000E+00/
     3887C     DATA (GB( 2,10,IC),IC=1,3) /
     3888C    S 0.24441465E+02, 0.10579514E+02, 0.10000000E+01/
    40693889C
    40703890C----- INTERVAL = 4 ----- T =  212.5
    40713891C
    40723892C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    4073       DATA (GA( 3, 9,IC),IC=1,3) /
    4074      S 0.24600320E+02, 0.10492949E+02, 0.00000000E+00/
    4075       DATA (GB( 3, 9,IC),IC=1,3) /
    4076      S 0.24600320E+02, 0.10608399E+02, 0.10000000E+01/
    4077       DATA (GA( 3,10,IC),IC=1,3) /
    4078      S 0.24311657E+02, 0.10439183E+02, 0.00000000E+00/
    4079       DATA (GB( 3,10,IC),IC=1,3) /
    4080      S 0.24311657E+02, 0.10555632E+02, 0.10000000E+01/
     3893C     DATA (GA( 3, 9,IC),IC=1,3) /
     3894C    S 0.24600320E+02, 0.10492949E+02, 0.00000000E+00/
     3895C     DATA (GB( 3, 9,IC),IC=1,3) /
     3896C    S 0.24600320E+02, 0.10608399E+02, 0.10000000E+01/
     3897C     DATA (GA( 3,10,IC),IC=1,3) /
     3898C    S 0.24311657E+02, 0.10439183E+02, 0.00000000E+00/
     3899C     DATA (GB( 3,10,IC),IC=1,3) /
     3900C    S 0.24311657E+02, 0.10555632E+02, 0.10000000E+01/
    40813901C
    40823902C----- INTERVAL = 4 ----- T =  225.0
    40833903C
    40843904C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    4085       DATA (GA( 4, 9,IC),IC=1,3) /
    4086      S 0.24487300E+02, 0.10472049E+02, 0.00000000E+00/
    4087       DATA (GB( 4, 9,IC),IC=1,3) /
    4088      S 0.24487300E+02, 0.10587891E+02, 0.10000000E+01/
    4089       DATA (GA( 4,10,IC),IC=1,3) /
    4090      S 0.24196167E+02, 0.10417324E+02, 0.00000000E+00/
    4091       DATA (GB( 4,10,IC),IC=1,3) /
    4092      S 0.24196167E+02, 0.10534169E+02, 0.10000000E+01/
     3905C     DATA (GA( 4, 9,IC),IC=1,3) /
     3906C    S 0.24487300E+02, 0.10472049E+02, 0.00000000E+00/
     3907C     DATA (GB( 4, 9,IC),IC=1,3) /
     3908C    S 0.24487300E+02, 0.10587891E+02, 0.10000000E+01/
     3909C     DATA (GA( 4,10,IC),IC=1,3) /
     3910C    S 0.24196167E+02, 0.10417324E+02, 0.00000000E+00/
     3911C     DATA (GB( 4,10,IC),IC=1,3) /
     3912C    S 0.24196167E+02, 0.10534169E+02, 0.10000000E+01/
    40933913C
    40943914C----- INTERVAL = 4 ----- T =  237.5
    40953915C
    40963916C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    4097       DATA (GA( 5, 9,IC),IC=1,3) /
    4098      S 0.24384935E+02, 0.10452961E+02, 0.00000000E+00/
    4099       DATA (GB( 5, 9,IC),IC=1,3) /
    4100      S 0.24384935E+02, 0.10569156E+02, 0.10000000E+01/
    4101       DATA (GA( 5,10,IC),IC=1,3) /
    4102      S 0.24093406E+02, 0.10397704E+02, 0.00000000E+00/
    4103       DATA (GB( 5,10,IC),IC=1,3) /
    4104      S 0.24093406E+02, 0.10514900E+02, 0.10000000E+01/
     3917C     DATA (GA( 5, 9,IC),IC=1,3) /
     3918C    S 0.24384935E+02, 0.10452961E+02, 0.00000000E+00/
     3919C     DATA (GB( 5, 9,IC),IC=1,3) /
     3920C    S 0.24384935E+02, 0.10569156E+02, 0.10000000E+01/
     3921C     DATA (GA( 5,10,IC),IC=1,3) /
     3922C    S 0.24093406E+02, 0.10397704E+02, 0.00000000E+00/
     3923C     DATA (GB( 5,10,IC),IC=1,3) /
     3924C    S 0.24093406E+02, 0.10514900E+02, 0.10000000E+01/
    41053925C
    41063926C----- INTERVAL = 4 ----- T =  250.0
    41073927C
    41083928C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    4109       DATA (GA( 6, 9,IC),IC=1,3) /
    4110      S 0.24292341E+02, 0.10435562E+02, 0.00000000E+00/
    4111       DATA (GB( 6, 9,IC),IC=1,3) /
    4112      S 0.24292341E+02, 0.10552075E+02, 0.10000000E+01/
    4113       DATA (GA( 6,10,IC),IC=1,3) /
    4114      S 0.24001597E+02, 0.10380038E+02, 0.00000000E+00/
    4115       DATA (GB( 6,10,IC),IC=1,3) /
    4116      S 0.24001597E+02, 0.10497547E+02, 0.10000000E+01/
     3929C     DATA (GA( 6, 9,IC),IC=1,3) /
     3930C    S 0.24292341E+02, 0.10435562E+02, 0.00000000E+00/
     3931C     DATA (GB( 6, 9,IC),IC=1,3) /
     3932C    S 0.24292341E+02, 0.10552075E+02, 0.10000000E+01/
     3933C     DATA (GA( 6,10,IC),IC=1,3) /
     3934C    S 0.24001597E+02, 0.10380038E+02, 0.00000000E+00/
     3935C     DATA (GB( 6,10,IC),IC=1,3) /
     3936C    S 0.24001597E+02, 0.10497547E+02, 0.10000000E+01/
    41173937C
    41183938C----- INTERVAL = 4 ----- T =  262.5
    41193939C
    41203940C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    4121       DATA (GA( 7, 9,IC),IC=1,3) /
    4122      S 0.24208572E+02, 0.10419710E+02, 0.00000000E+00/
    4123       DATA (GB( 7, 9,IC),IC=1,3) /
    4124      S 0.24208572E+02, 0.10536510E+02, 0.10000000E+01/
    4125       DATA (GA( 7,10,IC),IC=1,3) /
    4126      S 0.23919098E+02, 0.10364052E+02, 0.00000000E+00/
    4127       DATA (GB( 7,10,IC),IC=1,3) /
    4128      S 0.23919098E+02, 0.10481842E+02, 0.10000000E+01/
     3941C     DATA (GA( 7, 9,IC),IC=1,3) /
     3942C    S 0.24208572E+02, 0.10419710E+02, 0.00000000E+00/
     3943C     DATA (GB( 7, 9,IC),IC=1,3) /
     3944C    S 0.24208572E+02, 0.10536510E+02, 0.10000000E+01/
     3945C     DATA (GA( 7,10,IC),IC=1,3) /
     3946C    S 0.23919098E+02, 0.10364052E+02, 0.00000000E+00/
     3947C     DATA (GB( 7,10,IC),IC=1,3) /
     3948C    S 0.23919098E+02, 0.10481842E+02, 0.10000000E+01/
    41293949C
    41303950C----- INTERVAL = 4 ----- T =  275.0
    41313951C
    41323952C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    4133       DATA (GA( 8, 9,IC),IC=1,3) /
    4134      S 0.24132642E+02, 0.10405247E+02, 0.00000000E+00/
    4135       DATA (GB( 8, 9,IC),IC=1,3) /
    4136      S 0.24132642E+02, 0.10522307E+02, 0.10000000E+01/
    4137       DATA (GA( 8,10,IC),IC=1,3) /
    4138      S 0.23844511E+02, 0.10349509E+02, 0.00000000E+00/
    4139       DATA (GB( 8,10,IC),IC=1,3) /
    4140      S 0.23844511E+02, 0.10467553E+02, 0.10000000E+01/
     3953C     DATA (GA( 8, 9,IC),IC=1,3) /
     3954C    S 0.24132642E+02, 0.10405247E+02, 0.00000000E+00/
     3955C     DATA (GB( 8, 9,IC),IC=1,3) /
     3956C    S 0.24132642E+02, 0.10522307E+02, 0.10000000E+01/
     3957C     DATA (GA( 8,10,IC),IC=1,3) /
     3958C    S 0.23844511E+02, 0.10349509E+02, 0.00000000E+00/
     3959C     DATA (GB( 8,10,IC),IC=1,3) /
     3960C    S 0.23844511E+02, 0.10467553E+02, 0.10000000E+01/
    41413961C
    41423962C----- INTERVAL = 4 ----- T =  287.5
    41433963C
    41443964C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    4145       DATA (GA( 9, 9,IC),IC=1,3) /
    4146      S 0.24063614E+02, 0.10392022E+02, 0.00000000E+00/
    4147       DATA (GB( 9, 9,IC),IC=1,3) /
    4148      S 0.24063614E+02, 0.10509317E+02, 0.10000000E+01/
    4149       DATA (GA( 9,10,IC),IC=1,3) /
    4150      S 0.23776708E+02, 0.10336215E+02, 0.00000000E+00/
    4151       DATA (GB( 9,10,IC),IC=1,3) /
    4152      S 0.23776708E+02, 0.10454488E+02, 0.10000000E+01/
     3965C     DATA (GA( 9, 9,IC),IC=1,3) /
     3966C    S 0.24063614E+02, 0.10392022E+02, 0.00000000E+00/
     3967C     DATA (GB( 9, 9,IC),IC=1,3) /
     3968C    S 0.24063614E+02, 0.10509317E+02, 0.10000000E+01/
     3969C     DATA (GA( 9,10,IC),IC=1,3) /
     3970C    S 0.23776708E+02, 0.10336215E+02, 0.00000000E+00/
     3971C     DATA (GB( 9,10,IC),IC=1,3) /
     3972C    S 0.23776708E+02, 0.10454488E+02, 0.10000000E+01/
    41533973C
    41543974C----- INTERVAL = 4 ----- T =  300.0
    41553975C
    41563976C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    4157       DATA (GA(10, 9,IC),IC=1,3) /
    4158      S 0.24000649E+02, 0.10379892E+02, 0.00000000E+00/
    4159       DATA (GB(10, 9,IC),IC=1,3) /
    4160      S 0.24000649E+02, 0.10497402E+02, 0.10000000E+01/
    4161       DATA (GA(10,10,IC),IC=1,3) /
    4162      S 0.23714816E+02, 0.10324018E+02, 0.00000000E+00/
    4163       DATA (GB(10,10,IC),IC=1,3) /
    4164      S 0.23714816E+02, 0.10442501E+02, 0.10000000E+01/
     3977C     DATA (GA(10, 9,IC),IC=1,3) /
     3978C    S 0.24000649E+02, 0.10379892E+02, 0.00000000E+00/
     3979C     DATA (GB(10, 9,IC),IC=1,3) /
     3980C    S 0.24000649E+02, 0.10497402E+02, 0.10000000E+01/
     3981C     DATA (GA(10,10,IC),IC=1,3) /
     3982C    S 0.23714816E+02, 0.10324018E+02, 0.00000000E+00/
     3983C     DATA (GB(10,10,IC),IC=1,3) /
     3984C    S 0.23714816E+02, 0.10442501E+02, 0.10000000E+01/
    41653985C
    41663986C----- INTERVAL = 4 ----- T =  312.5
    41673987C
    41683988C-- INDICES FOR PADE APPROXIMATION     1   28   37   45
    4169       DATA (GA(11, 9,IC),IC=1,3) /
    4170      S 0.23943021E+02, 0.10368736E+02, 0.00000000E+00/
    4171       DATA (GB(11, 9,IC),IC=1,3) /
    4172      S 0.23943021E+02, 0.10486443E+02, 0.10000000E+01/
    4173       DATA (GA(11,10,IC),IC=1,3) /
    4174      S 0.23658197E+02, 0.10312808E+02, 0.00000000E+00/
    4175       DATA (GB(11,10,IC),IC=1,3) /
    4176      S 0.23658197E+02, 0.10431483E+02, 0.10000000E+01/
     3989C     DATA (GA(11, 9,IC),IC=1,3) /
     3990C    S 0.23943021E+02, 0.10368736E+02, 0.00000000E+00/
     3991C     DATA (GB(11, 9,IC),IC=1,3) /
     3992C    S 0.23943021E+02, 0.10486443E+02, 0.10000000E+01/
     3993C     DATA (GA(11,10,IC),IC=1,3) /
     3994C    S 0.23658197E+02, 0.10312808E+02, 0.00000000E+00/
     3995C     DATA (GB(11,10,IC),IC=1,3) /
     3996C    S 0.23658197E+02, 0.10431483E+02, 0.10000000E+01/
    41773997C
    41783998C
    … …  
    41874007C
    41884008C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4189       DATA (GA( 1, 5,IC),IC=1,3) /
    4190      S 0.15750172E+00,-0.22159303E-01, 0.00000000E+00/
    4191       DATA (GB( 1, 5,IC),IC=1,3) /
    4192      S 0.15750172E+00, 0.38103212E+00, 0.10000000E+01/
    4193       DATA (GA( 1, 6,IC),IC=1,3) /
    4194      S 0.17770551E+00,-0.24972399E-01, 0.00000000E+00/
    4195       DATA (GB( 1, 6,IC),IC=1,3) /
    4196      S 0.17770551E+00, 0.41646579E+00, 0.10000000E+01/
     4009C     DATA (GA( 1, 5,IC),IC=1,3) /
     4010C    S 0.15750172E+00,-0.22159303E-01, 0.00000000E+00/
     4011C     DATA (GB( 1, 5,IC),IC=1,3) /
     4012C    S 0.15750172E+00, 0.38103212E+00, 0.10000000E+01/
     4013C     DATA (GA( 1, 6,IC),IC=1,3) /
     4014C    S 0.17770551E+00,-0.24972399E-01, 0.00000000E+00/
     4015C     DATA (GB( 1, 6,IC),IC=1,3) /
     4016C    S 0.17770551E+00, 0.41646579E+00, 0.10000000E+01/
    41974017C
    41984018C----- INTERVAL = 5 ----- T =  200.0
    41994019C
    42004020C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4201       DATA (GA( 2, 5,IC),IC=1,3) /
    4202      S 0.16174076E+00,-0.22748917E-01, 0.00000000E+00/
    4203       DATA (GB( 2, 5,IC),IC=1,3) /
    4204      S 0.16174076E+00, 0.38913800E+00, 0.10000000E+01/
    4205       DATA (GA( 2, 6,IC),IC=1,3) /
    4206      S 0.18176757E+00,-0.25537247E-01, 0.00000000E+00/
    4207       DATA (GB( 2, 6,IC),IC=1,3) /
    4208      S 0.18176757E+00, 0.42345095E+00, 0.10000000E+01/
     4021C     DATA (GA( 2, 5,IC),IC=1,3) /
     4022C    S 0.16174076E+00,-0.22748917E-01, 0.00000000E+00/
     4023C     DATA (GB( 2, 5,IC),IC=1,3) /
     4024C    S 0.16174076E+00, 0.38913800E+00, 0.10000000E+01/
     4025C     DATA (GA( 2, 6,IC),IC=1,3) /
     4026C    S 0.18176757E+00,-0.25537247E-01, 0.00000000E+00/
     4027C     DATA (GB( 2, 6,IC),IC=1,3) /
     4028C    S 0.18176757E+00, 0.42345095E+00, 0.10000000E+01/
    42094029C
    42104030C----- INTERVAL = 5 ----- T =  212.5
    42114031C
    42124032C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4213       DATA (GA( 3, 5,IC),IC=1,3) /
    4214      S 0.16548628E+00,-0.23269898E-01, 0.00000000E+00/
    4215       DATA (GB( 3, 5,IC),IC=1,3) /
    4216      S 0.16548628E+00, 0.39613651E+00, 0.10000000E+01/
    4217       DATA (GA( 3, 6,IC),IC=1,3) /
    4218      S 0.18527967E+00,-0.26025624E-01, 0.00000000E+00/
    4219       DATA (GB( 3, 6,IC),IC=1,3) /
    4220      S 0.18527967E+00, 0.42937476E+00, 0.10000000E+01/
     4033C     DATA (GA( 3, 5,IC),IC=1,3) /
     4034C    S 0.16548628E+00,-0.23269898E-01, 0.00000000E+00/
     4035C     DATA (GB( 3, 5,IC),IC=1,3) /
     4036C    S 0.16548628E+00, 0.39613651E+00, 0.10000000E+01/
     4037C     DATA (GA( 3, 6,IC),IC=1,3) /
     4038C    S 0.18527967E+00,-0.26025624E-01, 0.00000000E+00/
     4039C     DATA (GB( 3, 6,IC),IC=1,3) /
     4040C    S 0.18527967E+00, 0.42937476E+00, 0.10000000E+01/
    42214041C
    42224042C----- INTERVAL = 5 ----- T =  225.0
    42234043C
    42244044C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4225       DATA (GA( 4, 5,IC),IC=1,3) /
    4226      S 0.16881124E+00,-0.23732392E-01, 0.00000000E+00/
    4227       DATA (GB( 4, 5,IC),IC=1,3) /
    4228      S 0.16881124E+00, 0.40222421E+00, 0.10000000E+01/
    4229       DATA (GA( 4, 6,IC),IC=1,3) /
    4230      S 0.18833348E+00,-0.26450280E-01, 0.00000000E+00/
    4231       DATA (GB( 4, 6,IC),IC=1,3) /
    4232      S 0.18833348E+00, 0.43444062E+00, 0.10000000E+01/
     4045C     DATA (GA( 4, 5,IC),IC=1,3) /
     4046C    S 0.16881124E+00,-0.23732392E-01, 0.00000000E+00/
     4047C     DATA (GB( 4, 5,IC),IC=1,3) /
     4048C    S 0.16881124E+00, 0.40222421E+00, 0.10000000E+01/
     4049C     DATA (GA( 4, 6,IC),IC=1,3) /
     4050C    S 0.18833348E+00,-0.26450280E-01, 0.00000000E+00/
     4051C     DATA (GB( 4, 6,IC),IC=1,3) /
     4052C    S 0.18833348E+00, 0.43444062E+00, 0.10000000E+01/
    42334053C
    42344054C----- INTERVAL = 5 ----- T =  237.5
    42354055C
    42364056C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4237       DATA (GA( 5, 5,IC),IC=1,3) /
    4238      S 0.17177839E+00,-0.24145123E-01, 0.00000000E+00/
    4239       DATA (GB( 5, 5,IC),IC=1,3) /
    4240      S 0.17177839E+00, 0.40756010E+00, 0.10000000E+01/
    4241       DATA (GA( 5, 6,IC),IC=1,3) /
    4242      S 0.19100108E+00,-0.26821236E-01, 0.00000000E+00/
    4243       DATA (GB( 5, 6,IC),IC=1,3) /
    4244      S 0.19100108E+00, 0.43880316E+00, 0.10000000E+01/
     4057C     DATA (GA( 5, 5,IC),IC=1,3) /
     4058C    S 0.17177839E+00,-0.24145123E-01, 0.00000000E+00/
     4059C     DATA (GB( 5, 5,IC),IC=1,3) /
     4060C    S 0.17177839E+00, 0.40756010E+00, 0.10000000E+01/
     4061C     DATA (GA( 5, 6,IC),IC=1,3) /
     4062C    S 0.19100108E+00,-0.26821236E-01, 0.00000000E+00/
     4063C     DATA (GB( 5, 6,IC),IC=1,3) /
     4064C    S 0.19100108E+00, 0.43880316E+00, 0.10000000E+01/
    42454065C
    42464066C----- INTERVAL = 5 ----- T =  250.0
    42474067C
    42484068C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4249       DATA (GA( 6, 5,IC),IC=1,3) /
    4250      S 0.17443933E+00,-0.24515269E-01, 0.00000000E+00/
    4251       DATA (GB( 6, 5,IC),IC=1,3) /
    4252      S 0.17443933E+00, 0.41226954E+00, 0.10000000E+01/
    4253       DATA (GA( 6, 6,IC),IC=1,3) /
    4254      S 0.19334122E+00,-0.27146657E-01, 0.00000000E+00/
    4255       DATA (GB( 6, 6,IC),IC=1,3) /
    4256      S 0.19334122E+00, 0.44258354E+00, 0.10000000E+01/
     4069C     DATA (GA( 6, 5,IC),IC=1,3) /
     4070C    S 0.17443933E+00,-0.24515269E-01, 0.00000000E+00/
     4071C     DATA (GB( 6, 5,IC),IC=1,3) /
     4072C    S 0.17443933E+00, 0.41226954E+00, 0.10000000E+01/
     4073C     DATA (GA( 6, 6,IC),IC=1,3) /
     4074C    S 0.19334122E+00,-0.27146657E-01, 0.00000000E+00/
     4075C     DATA (GB( 6, 6,IC),IC=1,3) /
     4076C    S 0.19334122E+00, 0.44258354E+00, 0.10000000E+01/
    42574077C
    42584078C----- INTERVAL = 5 ----- T =  262.5
    42594079C
    42604080C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4261       DATA (GA( 7, 5,IC),IC=1,3) /
    4262      S 0.17683622E+00,-0.24848690E-01, 0.00000000E+00/
    4263       DATA (GB( 7, 5,IC),IC=1,3) /
    4264      S 0.17683622E+00, 0.41645142E+00, 0.10000000E+01/
    4265       DATA (GA( 7, 6,IC),IC=1,3) /
    4266      S 0.19540288E+00,-0.27433354E-01, 0.00000000E+00/
    4267       DATA (GB( 7, 6,IC),IC=1,3) /
    4268      S 0.19540288E+00, 0.44587882E+00, 0.10000000E+01/
     4081C     DATA (GA( 7, 5,IC),IC=1,3) /
     4082C    S 0.17683622E+00,-0.24848690E-01, 0.00000000E+00/
     4083C     DATA (GB( 7, 5,IC),IC=1,3) /
     4084C    S 0.17683622E+00, 0.41645142E+00, 0.10000000E+01/
     4085C     DATA (GA( 7, 6,IC),IC=1,3) /
     4086C    S 0.19540288E+00,-0.27433354E-01, 0.00000000E+00/
     4087C     DATA (GB( 7, 6,IC),IC=1,3) /
     4088C    S 0.19540288E+00, 0.44587882E+00, 0.10000000E+01/
    42694089C
    42704090C----- INTERVAL = 5 ----- T =  275.0
    42714091C
    42724092C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4273       DATA (GA( 8, 5,IC),IC=1,3) /
    4274      S 0.17900375E+00,-0.25150210E-01, 0.00000000E+00/
    4275       DATA (GB( 8, 5,IC),IC=1,3) /
    4276      S 0.17900375E+00, 0.42018474E+00, 0.10000000E+01/
    4277       DATA (GA( 8, 6,IC),IC=1,3) /
    4278      S 0.19722732E+00,-0.27687065E-01, 0.00000000E+00/
    4279       DATA (GB( 8, 6,IC),IC=1,3) /
    4280      S 0.19722732E+00, 0.44876776E+00, 0.10000000E+01/
     4093C     DATA (GA( 8, 5,IC),IC=1,3) /
     4094C    S 0.17900375E+00,-0.25150210E-01, 0.00000000E+00/
     4095C     DATA (GB( 8, 5,IC),IC=1,3) /
     4096C    S 0.17900375E+00, 0.42018474E+00, 0.10000000E+01/
     4097C     DATA (GA( 8, 6,IC),IC=1,3) /
     4098C    S 0.19722732E+00,-0.27687065E-01, 0.00000000E+00/
     4099C     DATA (GB( 8, 6,IC),IC=1,3) /
     4100C    S 0.19722732E+00, 0.44876776E+00, 0.10000000E+01/
    42814101C
    42824102C----- INTERVAL = 5 ----- T =  287.5
    42834103C
    42844104C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4285       DATA (GA( 9, 5,IC),IC=1,3) /
    4286      S 0.18097099E+00,-0.25423873E-01, 0.00000000E+00/
    4287       DATA (GB( 9, 5,IC),IC=1,3) /
    4288      S 0.18097099E+00, 0.42353379E+00, 0.10000000E+01/
    4289       DATA (GA( 9, 6,IC),IC=1,3) /
    4290      S 0.19884918E+00,-0.27912608E-01, 0.00000000E+00/
    4291       DATA (GB( 9, 6,IC),IC=1,3) /
    4292      S 0.19884918E+00, 0.45131451E+00, 0.10000000E+01/
     4105C     DATA (GA( 9, 5,IC),IC=1,3) /
     4106C    S 0.18097099E+00,-0.25423873E-01, 0.00000000E+00/
     4107C     DATA (GB( 9, 5,IC),IC=1,3) /
     4108C    S 0.18097099E+00, 0.42353379E+00, 0.10000000E+01/
     4109C     DATA (GA( 9, 6,IC),IC=1,3) /
     4110C    S 0.19884918E+00,-0.27912608E-01, 0.00000000E+00/
     4111C     DATA (GB( 9, 6,IC),IC=1,3) /
     4112C    S 0.19884918E+00, 0.45131451E+00, 0.10000000E+01/
    42934113C
    42944114C----- INTERVAL = 5 ----- T =  300.0
    42954115C
    42964116C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4297       DATA (GA(10, 5,IC),IC=1,3) /
    4298      S 0.18276283E+00,-0.25673139E-01, 0.00000000E+00/
    4299       DATA (GB(10, 5,IC),IC=1,3) /
    4300      S 0.18276283E+00, 0.42655211E+00, 0.10000000E+01/
    4301       DATA (GA(10, 6,IC),IC=1,3) /
    4302      S 0.20029696E+00,-0.28113944E-01, 0.00000000E+00/
    4303       DATA (GB(10, 6,IC),IC=1,3) /
    4304      S 0.20029696E+00, 0.45357095E+00, 0.10000000E+01/
     4117C     DATA (GA(10, 5,IC),IC=1,3) /
     4118C    S 0.18276283E+00,-0.25673139E-01, 0.00000000E+00/
     4119C     DATA (GB(10, 5,IC),IC=1,3) /
     4120C    S 0.18276283E+00, 0.42655211E+00, 0.10000000E+01/
     4121C     DATA (GA(10, 6,IC),IC=1,3) /
     4122C    S 0.20029696E+00,-0.28113944E-01, 0.00000000E+00/
     4123C     DATA (GB(10, 6,IC),IC=1,3) /
     4124C    S 0.20029696E+00, 0.45357095E+00, 0.10000000E+01/
    43054125C
    43064126C----- INTERVAL = 5 ----- T =  312.5
    43074127C
    43084128C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4309       DATA (GA(11, 5,IC),IC=1,3) /
    4310      S 0.18440117E+00,-0.25901055E-01, 0.00000000E+00/
    4311       DATA (GB(11, 5,IC),IC=1,3) /
    4312      S 0.18440117E+00, 0.42928533E+00, 0.10000000E+01/
    4313       DATA (GA(11, 6,IC),IC=1,3) /
    4314      S 0.20159300E+00,-0.28294180E-01, 0.00000000E+00/
    4315       DATA (GB(11, 6,IC),IC=1,3) /
    4316      S 0.20159300E+00, 0.45557797E+00, 0.10000000E+01/
     4129C     DATA (GA(11, 5,IC),IC=1,3) /
     4130C    S 0.18440117E+00,-0.25901055E-01, 0.00000000E+00/
     4131C     DATA (GB(11, 5,IC),IC=1,3) /
     4132C    S 0.18440117E+00, 0.42928533E+00, 0.10000000E+01/
     4133C     DATA (GA(11, 6,IC),IC=1,3) /
     4134C    S 0.20159300E+00,-0.28294180E-01, 0.00000000E+00/
     4135C     DATA (GB(11, 6,IC),IC=1,3) /
     4136C    S 0.20159300E+00, 0.45557797E+00, 0.10000000E+01/
    43174137C
    43184138C
    … …  
    43264146C
    43274147C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4328       DATA (GA( 1,11,IC),IC=1,3) /
    4329      S 0.11990218E+02,-0.12823142E+01, 0.00000000E+00/
    4330       DATA (GB( 1,11,IC),IC=1,3) /
    4331      S 0.11990218E+02, 0.26681588E+02, 0.10000000E+01/
    4332       DATA (GA( 1,12,IC),IC=1,3) /
    4333      S 0.79709806E+01,-0.74805226E+00, 0.00000000E+00/
    4334       DATA (GB( 1,12,IC),IC=1,3) /
    4335      S 0.79709806E+01, 0.18377807E+02, 0.10000000E+01/
     4148C     DATA (GA( 1,11,IC),IC=1,3) /
     4149C    S 0.11990218E+02,-0.12823142E+01, 0.00000000E+00/
     4150C     DATA (GB( 1,11,IC),IC=1,3) /
     4151C    S 0.11990218E+02, 0.26681588E+02, 0.10000000E+01/
     4152C     DATA (GA( 1,12,IC),IC=1,3) /
     4153C    S 0.79709806E+01,-0.74805226E+00, 0.00000000E+00/
     4154C     DATA (GB( 1,12,IC),IC=1,3) /
     4155C    S 0.79709806E+01, 0.18377807E+02, 0.10000000E+01/
    43364156C
    43374157C----- INTERVAL = 6 ----- T =  200.0
    43384158C
    43394159C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4340       DATA (GA( 2,11,IC),IC=1,3) /
    4341      S 0.10904073E+02,-0.10571588E+01, 0.00000000E+00/
    4342       DATA (GB( 2,11,IC),IC=1,3) /
    4343      S 0.10904073E+02, 0.24728346E+02, 0.10000000E+01/
    4344       DATA (GA( 2,12,IC),IC=1,3) /
    4345      S 0.75400737E+01,-0.56252739E+00, 0.00000000E+00/
    4346       DATA (GB( 2,12,IC),IC=1,3) /
    4347      S 0.75400737E+01, 0.17643148E+02, 0.10000000E+01/
     4160C     DATA (GA( 2,11,IC),IC=1,3) /
     4161C    S 0.10904073E+02,-0.10571588E+01, 0.00000000E+00/
     4162C     DATA (GB( 2,11,IC),IC=1,3) /
     4163C    S 0.10904073E+02, 0.24728346E+02, 0.10000000E+01/
     4164C     DATA (GA( 2,12,IC),IC=1,3) /
     4165C    S 0.75400737E+01,-0.56252739E+00, 0.00000000E+00/
     4166C     DATA (GB( 2,12,IC),IC=1,3) /
     4167C    S 0.75400737E+01, 0.17643148E+02, 0.10000000E+01/
    43484168C
    43494169C----- INTERVAL = 6 ----- T =  212.5
    43504170C
    43514171C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4352       DATA (GA( 3,11,IC),IC=1,3) /
    4353      S 0.89126838E+01,-0.74864953E+00, 0.00000000E+00/
    4354       DATA (GB( 3,11,IC),IC=1,3) /
    4355      S 0.89126838E+01, 0.20551342E+02, 0.10000000E+01/
    4356       DATA (GA( 3,12,IC),IC=1,3) /
    4357      S 0.81804377E+01,-0.46188072E+00, 0.00000000E+00/
    4358       DATA (GB( 3,12,IC),IC=1,3) /
    4359      S 0.81804377E+01, 0.19296161E+02, 0.10000000E+01/
     4172C     DATA (GA( 3,11,IC),IC=1,3) /
     4173C    S 0.89126838E+01,-0.74864953E+00, 0.00000000E+00/
     4174C     DATA (GB( 3,11,IC),IC=1,3) /
     4175C    S 0.89126838E+01, 0.20551342E+02, 0.10000000E+01/
     4176C     DATA (GA( 3,12,IC),IC=1,3) /
     4177C    S 0.81804377E+01,-0.46188072E+00, 0.00000000E+00/
     4178C     DATA (GB( 3,12,IC),IC=1,3) /
     4179C    S 0.81804377E+01, 0.19296161E+02, 0.10000000E+01/
    43604180C
    43614181C----- INTERVAL = 6 ----- T =  225.0
    43624182C
    43634183C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4364       DATA (GA( 4,11,IC),IC=1,3) /
    4365      S 0.85622405E+01,-0.58705980E+00, 0.00000000E+00/
    4366       DATA (GB( 4,11,IC),IC=1,3) /
    4367      S 0.85622405E+01, 0.19955244E+02, 0.10000000E+01/
    4368       DATA (GA( 4,12,IC),IC=1,3) /
    4369      S 0.10564339E+02,-0.40712065E+00, 0.00000000E+00/
    4370       DATA (GB( 4,12,IC),IC=1,3) /
    4371      S 0.10564339E+02, 0.24951120E+02, 0.10000000E+01/
     4184C     DATA (GA( 4,11,IC),IC=1,3) /
     4185C    S 0.85622405E+01,-0.58705980E+00, 0.00000000E+00/
     4186C     DATA (GB( 4,11,IC),IC=1,3) /
     4187C    S 0.85622405E+01, 0.19955244E+02, 0.10000000E+01/
     4188C     DATA (GA( 4,12,IC),IC=1,3) /
     4189C    S 0.10564339E+02,-0.40712065E+00, 0.00000000E+00/
     4190C     DATA (GB( 4,12,IC),IC=1,3) /
     4191C    S 0.10564339E+02, 0.24951120E+02, 0.10000000E+01/
    43724192C
    43734193C----- INTERVAL = 6 ----- T =  237.5
    43744194C
    43754195C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4376       DATA (GA( 5,11,IC),IC=1,3) /
    4377      S 0.94892164E+01,-0.49305772E+00, 0.00000000E+00/
    4378       DATA (GB( 5,11,IC),IC=1,3) /
    4379      S 0.94892164E+01, 0.22227100E+02, 0.10000000E+01/
    4380       DATA (GA( 5,12,IC),IC=1,3) /
    4381      S 0.46896789E+02,-0.15295996E+01, 0.00000000E+00/
    4382       DATA (GB( 5,12,IC),IC=1,3) /
    4383      S 0.46896789E+02, 0.10957372E+03, 0.10000000E+01/
     4196C     DATA (GA( 5,11,IC),IC=1,3) /
     4197C    S 0.94892164E+01,-0.49305772E+00, 0.00000000E+00/
     4198C     DATA (GB( 5,11,IC),IC=1,3) /
     4199C    S 0.94892164E+01, 0.22227100E+02, 0.10000000E+01/
     4200C     DATA (GA( 5,12,IC),IC=1,3) /
     4201C    S 0.46896789E+02,-0.15295996E+01, 0.00000000E+00/
     4202C     DATA (GB( 5,12,IC),IC=1,3) /
     4203C    S 0.46896789E+02, 0.10957372E+03, 0.10000000E+01/
    43844204C
    43854205C----- INTERVAL = 6 ----- T =  250.0
    43864206C
    43874207C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4388       DATA (GA( 6,11,IC),IC=1,3) /
    4389      S 0.13580937E+02,-0.51461431E+00, 0.00000000E+00/
    4390       DATA (GB( 6,11,IC),IC=1,3) /
    4391      S 0.13580937E+02, 0.31770288E+02, 0.10000000E+01/
    4392       DATA (GA( 6,12,IC),IC=1,3) /
    4393      S-0.30926524E+01, 0.43555255E+00, 0.00000000E+00/
    4394       DATA (GB( 6,12,IC),IC=1,3) /
    4395      S-0.30926524E+01,-0.67432659E+01, 0.10000000E+01/
     4208C     DATA (GA( 6,11,IC),IC=1,3) /
     4209C    S 0.13580937E+02,-0.51461431E+00, 0.00000000E+00/
     4210C     DATA (GB( 6,11,IC),IC=1,3) /
     4211C    S 0.13580937E+02, 0.31770288E+02, 0.10000000E+01/
     4212C     DATA (GA( 6,12,IC),IC=1,3) /
     4213C    S-0.30926524E+01, 0.43555255E+00, 0.00000000E+00/
     4214C     DATA (GB( 6,12,IC),IC=1,3) /
     4215C    S-0.30926524E+01,-0.67432659E+01, 0.10000000E+01/
    43964216C
    43974217C----- INTERVAL = 6 ----- T =  262.5
    43984218C
    43994219C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4400       DATA (GA( 7,11,IC),IC=1,3) /
    4401      S-0.32050918E+03, 0.12373350E+02, 0.00000000E+00/
    4402       DATA (GB( 7,11,IC),IC=1,3) /
    4403      S-0.32050918E+03,-0.74061287E+03, 0.10000000E+01/
    4404       DATA (GA( 7,12,IC),IC=1,3) /
    4405      S 0.85742941E+00, 0.50380874E+00, 0.00000000E+00/
    4406       DATA (GB( 7,12,IC),IC=1,3) /
    4407      S 0.85742941E+00, 0.24550746E+01, 0.10000000E+01/
     4220C     DATA (GA( 7,11,IC),IC=1,3) /
     4221C    S-0.32050918E+03, 0.12373350E+02, 0.00000000E+00/
     4222C     DATA (GB( 7,11,IC),IC=1,3) /
     4223C    S-0.32050918E+03,-0.74061287E+03, 0.10000000E+01/
     4224C     DATA (GA( 7,12,IC),IC=1,3) /
     4225C    S 0.85742941E+00, 0.50380874E+00, 0.00000000E+00/
     4226C     DATA (GB( 7,12,IC),IC=1,3) /
     4227C    S 0.85742941E+00, 0.24550746E+01, 0.10000000E+01/
    44084228C
    44094229C----- INTERVAL = 6 ----- T =  275.0
    44104230C
    44114231C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4412       DATA (GA( 8,11,IC),IC=1,3) /
    4413      S-0.37133165E+01, 0.44809588E+00, 0.00000000E+00/
    4414       DATA (GB( 8,11,IC),IC=1,3) /
    4415      S-0.37133165E+01,-0.81329826E+01, 0.10000000E+01/
    4416       DATA (GA( 8,12,IC),IC=1,3) /
    4417      S 0.19164038E+01, 0.68537352E+00, 0.00000000E+00/
    4418       DATA (GB( 8,12,IC),IC=1,3) /
    4419      S 0.19164038E+01, 0.49089917E+01, 0.10000000E+01/
     4232C     DATA (GA( 8,11,IC),IC=1,3) /
     4233C    S-0.37133165E+01, 0.44809588E+00, 0.00000000E+00/
     4234C     DATA (GB( 8,11,IC),IC=1,3) /
     4235C    S-0.37133165E+01,-0.81329826E+01, 0.10000000E+01/
     4236C     DATA (GA( 8,12,IC),IC=1,3) /
     4237C    S 0.19164038E+01, 0.68537352E+00, 0.00000000E+00/
     4238C     DATA (GB( 8,12,IC),IC=1,3) /
     4239C    S 0.19164038E+01, 0.49089917E+01, 0.10000000E+01/
    44204240C
    44214241C----- INTERVAL = 6 ----- T =  287.5
    44224242C
    44234243C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4424       DATA (GA( 9,11,IC),IC=1,3) /
    4425      S 0.18890836E+00, 0.46548918E+00, 0.00000000E+00/
    4426       DATA (GB( 9,11,IC),IC=1,3) /
    4427      S 0.18890836E+00, 0.90279822E+00, 0.10000000E+01/
    4428       DATA (GA( 9,12,IC),IC=1,3) /
    4429      S 0.23513199E+01, 0.89437630E+00, 0.00000000E+00/
    4430       DATA (GB( 9,12,IC),IC=1,3) /
    4431      S 0.23513199E+01, 0.59008712E+01, 0.10000000E+01/
     4244C     DATA (GA( 9,11,IC),IC=1,3) /
     4245C    S 0.18890836E+00, 0.46548918E+00, 0.00000000E+00/
     4246C     DATA (GB( 9,11,IC),IC=1,3) /
     4247C    S 0.18890836E+00, 0.90279822E+00, 0.10000000E+01/
     4248C     DATA (GA( 9,12,IC),IC=1,3) /
     4249C    S 0.23513199E+01, 0.89437630E+00, 0.00000000E+00/
     4250C     DATA (GB( 9,12,IC),IC=1,3) /
     4251C    S 0.23513199E+01, 0.59008712E+01, 0.10000000E+01/
    44324252C
    44334253C----- INTERVAL = 6 ----- T =  300.0
    44344254C
    44354255C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4436       DATA (GA(10,11,IC),IC=1,3) /
    4437      S 0.14209226E+01, 0.59121475E+00, 0.00000000E+00/
    4438       DATA (GB(10,11,IC),IC=1,3) /
    4439      S 0.14209226E+01, 0.37532746E+01, 0.10000000E+01/
    4440       DATA (GA(10,12,IC),IC=1,3) /
    4441      S 0.25566644E+01, 0.11127003E+01, 0.00000000E+00/
    4442       DATA (GB(10,12,IC),IC=1,3) /
    4443      S 0.25566644E+01, 0.63532616E+01, 0.10000000E+01/
     4256C     DATA (GA(10,11,IC),IC=1,3) /
     4257C    S 0.14209226E+01, 0.59121475E+00, 0.00000000E+00/
     4258C     DATA (GB(10,11,IC),IC=1,3) /
     4259C    S 0.14209226E+01, 0.37532746E+01, 0.10000000E+01/
     4260C     DATA (GA(10,12,IC),IC=1,3) /
     4261C    S 0.25566644E+01, 0.11127003E+01, 0.00000000E+00/
     4262C     DATA (GB(10,12,IC),IC=1,3) /
     4263C    S 0.25566644E+01, 0.63532616E+01, 0.10000000E+01/
    44444264C
    44454265C----- INTERVAL = 6 ----- T =  312.5
    44464266C
    44474267C-- INDICES FOR PADE APPROXIMATION   1 35 40 45
    4448       DATA (GA(11,11,IC),IC=1,3) /
    4449      S 0.19817679E+01, 0.74676119E+00, 0.00000000E+00/
    4450       DATA (GB(11,11,IC),IC=1,3) /
    4451      S 0.19817679E+01, 0.50437916E+01, 0.10000000E+01/
    4452       DATA (GA(11,12,IC),IC=1,3) /
    4453      S 0.26555181E+01, 0.13329782E+01, 0.00000000E+00/
    4454       DATA (GB(11,12,IC),IC=1,3) /
    4455      S 0.26555181E+01, 0.65558627E+01, 0.10000000E+01/
     4268C     DATA (GA(11,11,IC),IC=1,3) /
     4269C    S 0.19817679E+01, 0.74676119E+00, 0.00000000E+00/
     4270C     DATA (GB(11,11,IC),IC=1,3) /
     4271C    S 0.19817679E+01, 0.50437916E+01, 0.10000000E+01/
     4272C     DATA (GA(11,12,IC),IC=1,3) /
     4273C    S 0.26555181E+01, 0.13329782E+01, 0.00000000E+00/
     4274C     DATA (GB(11,12,IC),IC=1,3) /
     4275C    S 0.26555181E+01, 0.65558627E+01, 0.10000000E+01/
    44564276C
    44574277C
    … …  
    44714291C
    44724292C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
    4473       DATA (GA( 1,13,IC),IC=1,3) /
    4474      S 0.87668459E-01, 0.13845511E+01, 0.00000000E+00/
    4475       DATA (GB( 1,13,IC),IC=1,3) /
    4476      S 0.87668459E-01, 0.23203798E+01, 0.10000000E+01/
    4477       DATA (GA( 1,14,IC),IC=1,3) /
    4478      S 0.74878820E-01, 0.11718758E+01, 0.00000000E+00/
    4479       DATA (GB( 1,14,IC),IC=1,3) /
    4480      S 0.74878820E-01, 0.20206726E+01, 0.10000000E+01/
     4293C     DATA (GA( 1,13,IC),IC=1,3) /
     4294C    S 0.87668459E-01, 0.13845511E+01, 0.00000000E+00/
     4295C     DATA (GB( 1,13,IC),IC=1,3) /
     4296C    S 0.87668459E-01, 0.23203798E+01, 0.10000000E+01/
     4297C     DATA (GA( 1,14,IC),IC=1,3) /
     4298C    S 0.74878820E-01, 0.11718758E+01, 0.00000000E+00/
     4299C     DATA (GB( 1,14,IC),IC=1,3) /
     4300C    S 0.74878820E-01, 0.20206726E+01, 0.10000000E+01/
    44814301C
    44824302C----- INTERVAL = 2 ----- T =  200.0
    44834303C
    44844304C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
    4485       DATA (GA( 2,13,IC),IC=1,3) /
    4486      S 0.83754276E-01, 0.13187042E+01, 0.00000000E+00/
    4487       DATA (GB( 2,13,IC),IC=1,3) /
    4488      S 0.83754276E-01, 0.22288925E+01, 0.10000000E+01/
    4489       DATA (GA( 2,14,IC),IC=1,3) /
    4490      S 0.71650966E-01, 0.11216131E+01, 0.00000000E+00/
    4491       DATA (GB( 2,14,IC),IC=1,3) /
    4492      S 0.71650966E-01, 0.19441824E+01, 0.10000000E+01/
     4305C     DATA (GA( 2,13,IC),IC=1,3) /
     4306C    S 0.83754276E-01, 0.13187042E+01, 0.00000000E+00/
     4307C     DATA (GB( 2,13,IC),IC=1,3) /
     4308C    S 0.83754276E-01, 0.22288925E+01, 0.10000000E+01/
     4309C     DATA (GA( 2,14,IC),IC=1,3) /
     4310C    S 0.71650966E-01, 0.11216131E+01, 0.00000000E+00/
     4311C     DATA (GB( 2,14,IC),IC=1,3) /
     4312C    S 0.71650966E-01, 0.19441824E+01, 0.10000000E+01/
    44934313C
    44944314C----- INTERVAL = 2 ----- T =  212.5
    44954315C
    44964316C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
    4497       DATA (GA( 3,13,IC),IC=1,3) /
    4498      S 0.80460283E-01, 0.12644396E+01, 0.00000000E+00/
    4499       DATA (GB( 3,13,IC),IC=1,3) /
    4500      S 0.80460283E-01, 0.21515593E+01, 0.10000000E+01/
    4501       DATA (GA( 3,14,IC),IC=1,3) /
    4502      S 0.68979615E-01, 0.10809473E+01, 0.00000000E+00/
    4503       DATA (GB( 3,14,IC),IC=1,3) /
    4504      S 0.68979615E-01, 0.18807257E+01, 0.10000000E+01/
     4317C     DATA (GA( 3,13,IC),IC=1,3) /
     4318C    S 0.80460283E-01, 0.12644396E+01, 0.00000000E+00/
     4319C     DATA (GB( 3,13,IC),IC=1,3) /
     4320C    S 0.80460283E-01, 0.21515593E+01, 0.10000000E+01/
     4321C     DATA (GA( 3,14,IC),IC=1,3) /
     4322C    S 0.68979615E-01, 0.10809473E+01, 0.00000000E+00/
     4323C     DATA (GB( 3,14,IC),IC=1,3) /
     4324C    S 0.68979615E-01, 0.18807257E+01, 0.10000000E+01/
    45054325C
    45064326C----- INTERVAL = 2 ----- T =  225.0
    45074327C
    45084328C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
    4509       DATA (GA( 4,13,IC),IC=1,3) /
    4510      S 0.77659686E-01, 0.12191543E+01, 0.00000000E+00/
    4511       DATA (GB( 4,13,IC),IC=1,3) /
    4512      S 0.77659686E-01, 0.20855896E+01, 0.10000000E+01/
    4513       DATA (GA( 4,14,IC),IC=1,3) /
    4514      S 0.66745345E-01, 0.10476396E+01, 0.00000000E+00/
    4515       DATA (GB( 4,14,IC),IC=1,3) /
    4516      S 0.66745345E-01, 0.18275618E+01, 0.10000000E+01/
     4329C     DATA (GA( 4,13,IC),IC=1,3) /
     4330C    S 0.77659686E-01, 0.12191543E+01, 0.00000000E+00/
     4331C     DATA (GB( 4,13,IC),IC=1,3) /
     4332C    S 0.77659686E-01, 0.20855896E+01, 0.10000000E+01/
     4333C     DATA (GA( 4,14,IC),IC=1,3) /
     4334C    S 0.66745345E-01, 0.10476396E+01, 0.00000000E+00/
     4335C     DATA (GB( 4,14,IC),IC=1,3) /
     4336C    S 0.66745345E-01, 0.18275618E+01, 0.10000000E+01/
    45174337C
    45184338C----- INTERVAL = 2 ----- T =  237.5
    45194339C
    45204340C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
    4521       DATA (GA( 5,13,IC),IC=1,3) /
    4522      S 0.75257056E-01, 0.11809511E+01, 0.00000000E+00/
    4523       DATA (GB( 5,13,IC),IC=1,3) /
    4524      S 0.75257056E-01, 0.20288489E+01, 0.10000000E+01/
    4525       DATA (GA( 5,14,IC),IC=1,3) /
    4526      S 0.64857571E-01, 0.10200373E+01, 0.00000000E+00/
    4527       DATA (GB( 5,14,IC),IC=1,3) /
    4528      S 0.64857571E-01, 0.17825910E+01, 0.10000000E+01/
     4341C     DATA (GA( 5,13,IC),IC=1,3) /
     4342C    S 0.75257056E-01, 0.11809511E+01, 0.00000000E+00/
     4343C     DATA (GB( 5,13,IC),IC=1,3) /
     4344C    S 0.75257056E-01, 0.20288489E+01, 0.10000000E+01/
     4345C     DATA (GA( 5,14,IC),IC=1,3) /
     4346C    S 0.64857571E-01, 0.10200373E+01, 0.00000000E+00/
     4347C     DATA (GB( 5,14,IC),IC=1,3) /
     4348C    S 0.64857571E-01, 0.17825910E+01, 0.10000000E+01/
    45294349C
    45304350C----- INTERVAL = 2 ----- T =  250.0
    45314351C
    45324352C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
    4533       DATA (GA( 6,13,IC),IC=1,3) /
    4534      S 0.73179175E-01, 0.11484154E+01, 0.00000000E+00/
    4535       DATA (GB( 6,13,IC),IC=1,3) /
    4536      S 0.73179175E-01, 0.19796791E+01, 0.10000000E+01/
    4537       DATA (GA( 6,14,IC),IC=1,3) /
    4538      S 0.63248495E-01, 0.99692726E+00, 0.00000000E+00/
    4539       DATA (GB( 6,14,IC),IC=1,3) /
    4540      S 0.63248495E-01, 0.17442308E+01, 0.10000000E+01/
     4353C     DATA (GA( 6,13,IC),IC=1,3) /
     4354C    S 0.73179175E-01, 0.11484154E+01, 0.00000000E+00/
     4355C     DATA (GB( 6,13,IC),IC=1,3) /
     4356C    S 0.73179175E-01, 0.19796791E+01, 0.10000000E+01/
     4357C     DATA (GA( 6,14,IC),IC=1,3) /
     4358C    S 0.63248495E-01, 0.99692726E+00, 0.00000000E+00/
     4359C     DATA (GB( 6,14,IC),IC=1,3) /
     4360C    S 0.63248495E-01, 0.17442308E+01, 0.10000000E+01/
    45414361C
    45424362C----- INTERVAL = 2 ----- T =  262.5
    45434363C
    45444364C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
    4545       DATA (GA( 7,13,IC),IC=1,3) /
    4546      S 0.71369063E-01, 0.11204723E+01, 0.00000000E+00/
    4547       DATA (GB( 7,13,IC),IC=1,3) /
    4548      S 0.71369063E-01, 0.19367778E+01, 0.10000000E+01/
    4549       DATA (GA( 7,14,IC),IC=1,3) /
    4550      S 0.61866970E-01, 0.97740923E+00, 0.00000000E+00/
    4551       DATA (GB( 7,14,IC),IC=1,3) /
    4552      S 0.61866970E-01, 0.17112809E+01, 0.10000000E+01/
     4365C     DATA (GA( 7,13,IC),IC=1,3) /
     4366C    S 0.71369063E-01, 0.11204723E+01, 0.00000000E+00/
     4367C     DATA (GB( 7,13,IC),IC=1,3) /
     4368C    S 0.71369063E-01, 0.19367778E+01, 0.10000000E+01/
     4369C     DATA (GA( 7,14,IC),IC=1,3) /
     4370C    S 0.61866970E-01, 0.97740923E+00, 0.00000000E+00/
     4371C     DATA (GB( 7,14,IC),IC=1,3) /
     4372C    S 0.61866970E-01, 0.17112809E+01, 0.10000000E+01/
    45534373C
    45544374C----- INTERVAL = 2 ----- T =  275.0
    45554375C
    45564376C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
    4557       DATA (GA( 8,13,IC),IC=1,3) /
    4558      S 0.69781812E-01, 0.10962918E+01, 0.00000000E+00/
    4559       DATA (GB( 8,13,IC),IC=1,3) /
    4560      S 0.69781812E-01, 0.18991112E+01, 0.10000000E+01/
    4561       DATA (GA( 8,14,IC),IC=1,3) /
    4562      S 0.60673632E-01, 0.96080188E+00, 0.00000000E+00/
    4563       DATA (GB( 8,14,IC),IC=1,3) /
    4564      S 0.60673632E-01, 0.16828137E+01, 0.10000000E+01/
     4377C     DATA (GA( 8,13,IC),IC=1,3) /
     4378C    S 0.69781812E-01, 0.10962918E+01, 0.00000000E+00/
     4379C     DATA (GB( 8,13,IC),IC=1,3) /
     4380C    S 0.69781812E-01, 0.18991112E+01, 0.10000000E+01/
     4381C     DATA (GA( 8,14,IC),IC=1,3) /
     4382C    S 0.60673632E-01, 0.96080188E+00, 0.00000000E+00/
     4383C     DATA (GB( 8,14,IC),IC=1,3) /
     4384C    S 0.60673632E-01, 0.16828137E+01, 0.10000000E+01/
    45654385C
    45664386C----- INTERVAL = 2 ----- T =  287.5
    45674387C
    45684388C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
    4569       DATA (GA( 9,13,IC),IC=1,3) /
    4570      S 0.68381606E-01, 0.10752229E+01, 0.00000000E+00/
    4571       DATA (GB( 9,13,IC),IC=1,3) /
    4572      S 0.68381606E-01, 0.18658501E+01, 0.10000000E+01/
    4573       DATA (GA( 9,14,IC),IC=1,3) /
    4574      S 0.59637277E-01, 0.94657562E+00, 0.00000000E+00/
    4575       DATA (GB( 9,14,IC),IC=1,3) /
    4576      S 0.59637277E-01, 0.16580908E+01, 0.10000000E+01/
     4389C     DATA (GA( 9,13,IC),IC=1,3) /
     4390C    S 0.68381606E-01, 0.10752229E+01, 0.00000000E+00/
     4391C     DATA (GB( 9,13,IC),IC=1,3) /
     4392C    S 0.68381606E-01, 0.18658501E+01, 0.10000000E+01/
     4393C     DATA (GA( 9,14,IC),IC=1,3) /
     4394C    S 0.59637277E-01, 0.94657562E+00, 0.00000000E+00/
     4395C     DATA (GB( 9,14,IC),IC=1,3) /
     4396C    S 0.59637277E-01, 0.16580908E+01, 0.10000000E+01/
    45774397C
    45784398C----- INTERVAL = 2 ----- T =  300.0
    45794399C
    45804400C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
    4581       DATA (GA(10,13,IC),IC=1,3) /
    4582      S 0.67139539E-01, 0.10567474E+01, 0.00000000E+00/
    4583       DATA (GB(10,13,IC),IC=1,3) /
    4584      S 0.67139539E-01, 0.18363226E+01, 0.10000000E+01/
    4585       DATA (GA(10,14,IC),IC=1,3) /
    4586      S 0.58732178E-01, 0.93430511E+00, 0.00000000E+00/
    4587       DATA (GB(10,14,IC),IC=1,3) /
    4588      S 0.58732178E-01, 0.16365014E+01, 0.10000000E+01/
     4401C     DATA (GA(10,13,IC),IC=1,3) /
     4402C    S 0.67139539E-01, 0.10567474E+01, 0.00000000E+00/
     4403C     DATA (GB(10,13,IC),IC=1,3) /
     4404C    S 0.67139539E-01, 0.18363226E+01, 0.10000000E+01/
     4405C     DATA (GA(10,14,IC),IC=1,3) /
     4406C    S 0.58732178E-01, 0.93430511E+00, 0.00000000E+00/
     4407C     DATA (GB(10,14,IC),IC=1,3) /
     4408C    S 0.58732178E-01, 0.16365014E+01, 0.10000000E+01/
    45894409C
    45904410C----- INTERVAL = 2 ----- T =  312.5
    45914411C
    45924412C-- INDICES FOR PADE APPROXIMATION   1 30 38 45
    4593       DATA (GA(11,13,IC),IC=1,3) /
    4594      S 0.66032012E-01, 0.10404465E+01, 0.00000000E+00/
    4595       DATA (GB(11,13,IC),IC=1,3) /
    4596      S 0.66032012E-01, 0.18099779E+01, 0.10000000E+01/
    4597       DATA (GA(11,14,IC),IC=1,3) /
    4598      S 0.57936092E-01, 0.92363528E+00, 0.00000000E+00/
    4599       DATA (GB(11,14,IC),IC=1,3) /
    4600      S 0.57936092E-01, 0.16175164E+01, 0.10000000E+01/
     4413C     DATA (GA(11,13,IC),IC=1,3) /
     4414C    S 0.66032012E-01, 0.10404465E+01, 0.00000000E+00/
     4415C     DATA (GB(11,13,IC),IC=1,3) /
     4416C    S 0.66032012E-01, 0.18099779E+01, 0.10000000E+01/
     4417C     DATA (GA(11,14,IC),IC=1,3) /
     4418C    S 0.57936092E-01, 0.92363528E+00, 0.00000000E+00/
     4419C     DATA (GB(11,14,IC),IC=1,3) /
     4420C    S 0.57936092E-01, 0.16175164E+01, 0.10000000E+01/
    46014421C
    46024422C
    … …  
    46184438C
    46194439C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    4620       DATA (GA( 1,15,IC),IC=1,3) /
    4621      S 0.13230067E+02, 0.22042132E+02, 0.00000000E+00/
    4622       DATA (GB( 1,15,IC),IC=1,3) /
    4623      S 0.13230067E+02, 0.22051750E+02, 0.10000000E+01/
    4624       DATA (GA( 1,16,IC),IC=1,3) /
    4625      S 0.13183816E+02, 0.22169501E+02, 0.00000000E+00/
    4626       DATA (GB( 1,16,IC),IC=1,3) /
    4627      S 0.13183816E+02, 0.22178972E+02, 0.10000000E+01/
     4440C     DATA (GA( 1,15,IC),IC=1,3) /
     4441C    S 0.13230067E+02, 0.22042132E+02, 0.00000000E+00/
     4442C     DATA (GB( 1,15,IC),IC=1,3) /
     4443C    S 0.13230067E+02, 0.22051750E+02, 0.10000000E+01/
     4444C     DATA (GA( 1,16,IC),IC=1,3) /
     4445C    S 0.13183816E+02, 0.22169501E+02, 0.00000000E+00/
     4446C     DATA (GB( 1,16,IC),IC=1,3) /
     4447C    S 0.13183816E+02, 0.22178972E+02, 0.10000000E+01/
    46284448C
    46294449C----- INTERVAL = 4 ----- T =  200.0
    46304450C
    46314451C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    4632       DATA (GA( 2,15,IC),IC=1,3) /
    4633      S 0.13213564E+02, 0.22107298E+02, 0.00000000E+00/
    4634       DATA (GB( 2,15,IC),IC=1,3) /
    4635      S 0.13213564E+02, 0.22116850E+02, 0.10000000E+01/
    4636       DATA (GA( 2,16,IC),IC=1,3) /
    4637      S 0.13189991E+02, 0.22270075E+02, 0.00000000E+00/
    4638       DATA (GB( 2,16,IC),IC=1,3) /
    4639      S 0.13189991E+02, 0.22279484E+02, 0.10000000E+01/
     4452C     DATA (GA( 2,15,IC),IC=1,3) /
     4453C    S 0.13213564E+02, 0.22107298E+02, 0.00000000E+00/
     4454C     DATA (GB( 2,15,IC),IC=1,3) /
     4455C    S 0.13213564E+02, 0.22116850E+02, 0.10000000E+01/
     4456C     DATA (GA( 2,16,IC),IC=1,3) /
     4457C    S 0.13189991E+02, 0.22270075E+02, 0.00000000E+00/
     4458C     DATA (GB( 2,16,IC),IC=1,3) /
     4459C    S 0.13189991E+02, 0.22279484E+02, 0.10000000E+01/
    46404460C
    46414461C----- INTERVAL = 4 ----- T =  212.5
    46424462C
    46434463C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    4644       DATA (GA( 3,15,IC),IC=1,3) /
    4645      S 0.13209140E+02, 0.22180915E+02, 0.00000000E+00/
    4646       DATA (GB( 3,15,IC),IC=1,3) /
    4647      S 0.13209140E+02, 0.22190410E+02, 0.10000000E+01/
    4648       DATA (GA( 3,16,IC),IC=1,3) /
    4649      S 0.13209485E+02, 0.22379193E+02, 0.00000000E+00/
    4650       DATA (GB( 3,16,IC),IC=1,3) /
    4651      S 0.13209485E+02, 0.22388551E+02, 0.10000000E+01/
     4464C     DATA (GA( 3,15,IC),IC=1,3) /
     4465C    S 0.13209140E+02, 0.22180915E+02, 0.00000000E+00/
     4466C     DATA (GB( 3,15,IC),IC=1,3) /
     4467C    S 0.13209140E+02, 0.22190410E+02, 0.10000000E+01/
     4468C     DATA (GA( 3,16,IC),IC=1,3) /
     4469C    S 0.13209485E+02, 0.22379193E+02, 0.00000000E+00/
     4470C     DATA (GB( 3,16,IC),IC=1,3) /
     4471C    S 0.13209485E+02, 0.22388551E+02, 0.10000000E+01/
    46524472C
    46534473C----- INTERVAL = 4 ----- T =  225.0
    46544474C
    46554475C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    4656       DATA (GA( 4,15,IC),IC=1,3) /
    4657      S 0.13213894E+02, 0.22259478E+02, 0.00000000E+00/
    4658       DATA (GB( 4,15,IC),IC=1,3) /
    4659      S 0.13213894E+02, 0.22268925E+02, 0.10000000E+01/
    4660       DATA (GA( 4,16,IC),IC=1,3) /
    4661      S 0.13238789E+02, 0.22492992E+02, 0.00000000E+00/
    4662       DATA (GB( 4,16,IC),IC=1,3) /
    4663      S 0.13238789E+02, 0.22502309E+02, 0.10000000E+01/
     4476C     DATA (GA( 4,15,IC),IC=1,3) /
     4477C    S 0.13213894E+02, 0.22259478E+02, 0.00000000E+00/
     4478C     DATA (GB( 4,15,IC),IC=1,3) /
     4479C    S 0.13213894E+02, 0.22268925E+02, 0.10000000E+01/
     4480C     DATA (GA( 4,16,IC),IC=1,3) /
     4481C    S 0.13238789E+02, 0.22492992E+02, 0.00000000E+00/
     4482C     DATA (GB( 4,16,IC),IC=1,3) /
     4483C    S 0.13238789E+02, 0.22502309E+02, 0.10000000E+01/
    46644484C
    46654485C----- INTERVAL = 4 ----- T =  237.5
    46664486C
    46674487C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    4668       DATA (GA( 5,15,IC),IC=1,3) /
    4669      S 0.13225963E+02, 0.22341039E+02, 0.00000000E+00/
    4670       DATA (GB( 5,15,IC),IC=1,3) /
    4671      S 0.13225963E+02, 0.22350445E+02, 0.10000000E+01/
    4672       DATA (GA( 5,16,IC),IC=1,3) /
    4673      S 0.13275017E+02, 0.22608508E+02, 0.00000000E+00/
    4674       DATA (GB( 5,16,IC),IC=1,3) /
    4675      S 0.13275017E+02, 0.22617792E+02, 0.10000000E+01/
     4488C     DATA (GA( 5,15,IC),IC=1,3) /
     4489C    S 0.13225963E+02, 0.22341039E+02, 0.00000000E+00/
     4490C     DATA (GB( 5,15,IC),IC=1,3) /
     4491C    S 0.13225963E+02, 0.22350445E+02, 0.10000000E+01/
     4492C     DATA (GA( 5,16,IC),IC=1,3) /
     4493C    S 0.13275017E+02, 0.22608508E+02, 0.00000000E+00/
     4494C     DATA (GB( 5,16,IC),IC=1,3) /
     4495C    S 0.13275017E+02, 0.22617792E+02, 0.10000000E+01/
    46764496C
    46774497C----- INTERVAL = 4 ----- T =  250.0
    46784498C
    46794499C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    4680       DATA (GA( 6,15,IC),IC=1,3) /
    4681      S 0.13243806E+02, 0.22424247E+02, 0.00000000E+00/
    4682       DATA (GB( 6,15,IC),IC=1,3) /
    4683      S 0.13243806E+02, 0.22433617E+02, 0.10000000E+01/
    4684       DATA (GA( 6,16,IC),IC=1,3) /
    4685      S 0.13316096E+02, 0.22723843E+02, 0.00000000E+00/
    4686       DATA (GB( 6,16,IC),IC=1,3) /
    4687      S 0.13316096E+02, 0.22733099E+02, 0.10000000E+01/
     4500C     DATA (GA( 6,15,IC),IC=1,3) /
     4501C    S 0.13243806E+02, 0.22424247E+02, 0.00000000E+00/
     4502C     DATA (GB( 6,15,IC),IC=1,3) /
     4503C    S 0.13243806E+02, 0.22433617E+02, 0.10000000E+01/
     4504C     DATA (GA( 6,16,IC),IC=1,3) /
     4505C    S 0.13316096E+02, 0.22723843E+02, 0.00000000E+00/
     4506C     DATA (GB( 6,16,IC),IC=1,3) /
     4507C    S 0.13316096E+02, 0.22733099E+02, 0.10000000E+01/
    46884508C
    46894509C----- INTERVAL = 4 ----- T =  262.5
    46904510C
    46914511C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    4692       DATA (GA( 7,15,IC),IC=1,3) /
    4693      S 0.13266104E+02, 0.22508089E+02, 0.00000000E+00/
    4694       DATA (GB( 7,15,IC),IC=1,3) /
    4695      S 0.13266104E+02, 0.22517429E+02, 0.10000000E+01/
    4696       DATA (GA( 7,16,IC),IC=1,3) /
    4697      S 0.13360555E+02, 0.22837837E+02, 0.00000000E+00/
    4698       DATA (GB( 7,16,IC),IC=1,3) /
    4699      S 0.13360555E+02, 0.22847071E+02, 0.10000000E+01/
     4512C     DATA (GA( 7,15,IC),IC=1,3) /
     4513C    S 0.13266104E+02, 0.22508089E+02, 0.00000000E+00/
     4514C     DATA (GB( 7,15,IC),IC=1,3) /
     4515C    S 0.13266104E+02, 0.22517429E+02, 0.10000000E+01/
     4516C     DATA (GA( 7,16,IC),IC=1,3) /
     4517C    S 0.13360555E+02, 0.22837837E+02, 0.00000000E+00/
     4518C     DATA (GB( 7,16,IC),IC=1,3) /
     4519C    S 0.13360555E+02, 0.22847071E+02, 0.10000000E+01/
    47004520C
    47014521C----- INTERVAL = 4 ----- T =  275.0
    47024522C
    47034523C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    4704       DATA (GA( 8,15,IC),IC=1,3) /
    4705      S 0.13291782E+02, 0.22591771E+02, 0.00000000E+00/
    4706       DATA (GB( 8,15,IC),IC=1,3) /
    4707      S 0.13291782E+02, 0.22601086E+02, 0.10000000E+01/
    4708       DATA (GA( 8,16,IC),IC=1,3) /
    4709      S 0.13407324E+02, 0.22949751E+02, 0.00000000E+00/
    4710       DATA (GB( 8,16,IC),IC=1,3) /
    4711      S 0.13407324E+02, 0.22958967E+02, 0.10000000E+01/
     4524C     DATA (GA( 8,15,IC),IC=1,3) /
     4525C    S 0.13291782E+02, 0.22591771E+02, 0.00000000E+00/
     4526C     DATA (GB( 8,15,IC),IC=1,3) /
     4527C    S 0.13291782E+02, 0.22601086E+02, 0.10000000E+01/
     4528C     DATA (GA( 8,16,IC),IC=1,3) /
     4529C    S 0.13407324E+02, 0.22949751E+02, 0.00000000E+00/
     4530C     DATA (GB( 8,16,IC),IC=1,3) /
     4531C    S 0.13407324E+02, 0.22958967E+02, 0.10000000E+01/
    47124532C
    47134533C----- INTERVAL = 4 ----- T =  287.5
    47144534C
    47154535C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    4716       DATA (GA( 9,15,IC),IC=1,3) /
    4717      S 0.13319961E+02, 0.22674661E+02, 0.00000000E+00/
    4718       DATA (GB( 9,15,IC),IC=1,3) /
    4719      S 0.13319961E+02, 0.22683956E+02, 0.10000000E+01/
    4720       DATA (GA( 9,16,IC),IC=1,3) /
    4721      S 0.13455544E+02, 0.23059032E+02, 0.00000000E+00/
    4722       DATA (GB( 9,16,IC),IC=1,3) /
    4723      S 0.13455544E+02, 0.23068234E+02, 0.10000000E+01/
     4536C     DATA (GA( 9,15,IC),IC=1,3) /
     4537C    S 0.13319961E+02, 0.22674661E+02, 0.00000000E+00/
     4538C     DATA (GB( 9,15,IC),IC=1,3) /
     4539C    S 0.13319961E+02, 0.22683956E+02, 0.10000000E+01/
     4540C     DATA (GA( 9,16,IC),IC=1,3) /
     4541C    S 0.13455544E+02, 0.23059032E+02, 0.00000000E+00/
     4542C     DATA (GB( 9,16,IC),IC=1,3) /
     4543C    S 0.13455544E+02, 0.23068234E+02, 0.10000000E+01/
    47244544C
    47254545C----- INTERVAL = 4 ----- T =  300.0
    47264546C
    47274547C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    4728       DATA (GA(10,15,IC),IC=1,3) /
    4729      S 0.13349927E+02, 0.22756246E+02, 0.00000000E+00/
    4730       DATA (GB(10,15,IC),IC=1,3) /
    4731      S 0.13349927E+02, 0.22765522E+02, 0.10000000E+01/
    4732       DATA (GA(10,16,IC),IC=1,3) /
    4733      S 0.13504450E+02, 0.23165146E+02, 0.00000000E+00/
    4734       DATA (GB(10,16,IC),IC=1,3) /
    4735      S 0.13504450E+02, 0.23174336E+02, 0.10000000E+01/
     4548C     DATA (GA(10,15,IC),IC=1,3) /
     4549C    S 0.13349927E+02, 0.22756246E+02, 0.00000000E+00/
     4550C     DATA (GB(10,15,IC),IC=1,3) /
     4551C    S 0.13349927E+02, 0.22765522E+02, 0.10000000E+01/
     4552C     DATA (GA(10,16,IC),IC=1,3) /
     4553C    S 0.13504450E+02, 0.23165146E+02, 0.00000000E+00/
     4554C     DATA (GB(10,16,IC),IC=1,3) /
     4555C    S 0.13504450E+02, 0.23174336E+02, 0.10000000E+01/
    47364556C
    47374557C----- INTERVAL = 4 ----- T =  312.5
    47384558C
    47394559C-- INDICES FOR PADE APPROXIMATION     1   15   29   45
    4740       DATA (GA(11,15,IC),IC=1,3) /
    4741      S 0.13381108E+02, 0.22836093E+02, 0.00000000E+00/
    4742       DATA (GB(11,15,IC),IC=1,3) /
    4743      S 0.13381108E+02, 0.22845354E+02, 0.10000000E+01/
    4744       DATA (GA(11,16,IC),IC=1,3) /
    4745      S 0.13553282E+02, 0.23267456E+02, 0.00000000E+00/
    4746       DATA (GB(11,16,IC),IC=1,3) /
    4747      S 0.13553282E+02, 0.23276638E+02, 0.10000000E+01/
     4560C     DATA (GA(11,15,IC),IC=1,3) /
     4561C    S 0.13381108E+02, 0.22836093E+02, 0.00000000E+00/
     4562C     DATA (GB(11,15,IC),IC=1,3) /
     4563C    S 0.13381108E+02, 0.22845354E+02, 0.10000000E+01/
     4564C     DATA (GA(11,16,IC),IC=1,3) /
     4565C    S 0.13553282E+02, 0.23267456E+02, 0.00000000E+00/
     4566C     DATA (GB(11,16,IC),IC=1,3) /
     4567C    S 0.13553282E+02, 0.23276638E+02, 0.10000000E+01/
     4568C
     4569C     ------------------------------------------------------------------
     4570C     DATA (( XP(  J,K),J=1,6),       K=1,6) /
     4571C    S 0.46430621E+02, 0.12928299E+03, 0.20732648E+03,
     4572C    S 0.31398411E+03, 0.18373177E+03,-0.11412303E+03,
     4573C    S 0.73604774E+02, 0.27887914E+03, 0.27076947E+03,
     4574C    S-0.57322111E+02,-0.64742459E+02, 0.87238280E+02,
     4575C    S 0.37050866E+02, 0.20498759E+03, 0.37558029E+03,
     4576C    S 0.17401171E+03,-0.13350302E+03,-0.37651795E+02,
     4577C    S 0.14930141E+02, 0.89161160E+02, 0.17793062E+03,
     4578C    S 0.93433860E+02,-0.70646020E+02,-0.26373150E+02,
     4579C    S 0.40386780E+02, 0.10855270E+03, 0.50755010E+02,
     4580C    S-0.31496190E+02, 0.12791300E+00, 0.18017770E+01,
     4581C    S 0.90811926E+01, 0.75073923E+02, 0.24654438E+03,
     4582C    S 0.39332612E+03, 0.29385281E+03, 0.89107921E+02 /
    47484583
    4749 C     ------------------------------------------------------------------
    4750       DATA (( XP(  J,K),J=1,6),       K=1,6) /
    4751      S 0.46430621E+02, 0.12928299E+03, 0.20732648E+03,
    4752      S 0.31398411E+03, 0.18373177E+03,-0.11412303E+03,
    4753      S 0.73604774E+02, 0.27887914E+03, 0.27076947E+03,
    4754      S-0.57322111E+02,-0.64742459E+02, 0.87238280E+02,
    4755      S 0.37050866E+02, 0.20498759E+03, 0.37558029E+03,
    4756      S 0.17401171E+03,-0.13350302E+03,-0.37651795E+02,
    4757      S 0.14930141E+02, 0.89161160E+02, 0.17793062E+03,
    4758      S 0.93433860E+02,-0.70646020E+02,-0.26373150E+02,
    4759      S 0.40386780E+02, 0.10855270E+03, 0.50755010E+02,
    4760      S-0.31496190E+02, 0.12791300E+00, 0.18017770E+01,
    4761      S 0.90811926E+01, 0.75073923E+02, 0.24654438E+03,
    4762      S 0.39332612E+03, 0.29385281E+03, 0.89107921E+02 /
    47634584C
    47644585C
    … …  
    47684589 100  CONTINUE
    47694590C
     4591!cdir collapse
    47704592      DO 102 JK = 1 , KFLEV+1
    47714593      DO 101 JL = 1, KDLON
    … …  
    49594781      INTEGER KUAER,KTRAER, KLIM
    49604782C
    4961       REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS
    4962       REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
    4963       REAL*8 PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS
    4964       REAL*8 PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
    4965       REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION
    4966       REAL*8 PBTOP(KDLON,Ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION
    4967       REAL*8 PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
    4968       REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY
    4969       REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
    4970       REAL*8 PTAVE(KDLON,KFLEV) ! TEMPERATURE
    4971       REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
    4972       REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
    4973       REAL*8 PGASUR(KDLON,8,2) ! PADE APPROXIMANTS
    4974       REAL*8 PGBSUR(KDLON,8,2) ! PADE APPROXIMANTS
    4975       REAL*8 PGATOP(KDLON,8,2) ! PADE APPROXIMANTS
    4976       REAL*8 PGBTOP(KDLON,8,2) ! PADE APPROXIMANTS
    4977 C
    4978       REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
    4979       REAL*8 PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM
    4980       REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
     4783      REAL(KIND=8) PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS
     4784      REAL(KIND=8) PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
     4785      REAL(KIND=8) PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS
     4786      REAL(KIND=8) PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
     4787      REAL(KIND=8) PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION
     4788      REAL(KIND=8) PBTOP(KDLON,Ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION
     4789      REAL(KIND=8) PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
     4790      REAL(KIND=8) PEMIS(KDLON) ! SURFACE EMISSIVITY
     4791      REAL(KIND=8) PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
     4792      REAL(KIND=8) PTAVE(KDLON,KFLEV) ! TEMPERATURE
     4793      REAL(KIND=8) PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
     4794      REAL(KIND=8) PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
     4795      REAL(KIND=8) PGASUR(KDLON,8,2) ! PADE APPROXIMANTS
     4796      REAL(KIND=8) PGBSUR(KDLON,8,2) ! PADE APPROXIMANTS
     4797      REAL(KIND=8) PGATOP(KDLON,8,2) ! PADE APPROXIMANTS
     4798      REAL(KIND=8) PGBTOP(KDLON,8,2) ! PADE APPROXIMANTS
     4799C
     4800      REAL(KIND=8) PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
     4801      REAL(KIND=8) PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM
     4802      REAL(KIND=8) PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
    49814803C-----------------------------------------------------------------------
    49824804C LOCAL VARIABLES:
    4983       REAL*8 ZADJD(KDLON,KFLEV+1)
    4984       REAL*8 ZADJU(KDLON,KFLEV+1)
    4985       REAL*8 ZDBDT(KDLON,Ninter,KFLEV)
    4986       REAL*8 ZDISD(KDLON,KFLEV+1)
    4987       REAL*8 ZDISU(KDLON,KFLEV+1)
     4805      REAL(KIND=8) ZADJD(KDLON,KFLEV+1)
     4806      REAL(KIND=8) ZADJU(KDLON,KFLEV+1)
     4807      REAL(KIND=8) ZDBDT(KDLON,Ninter,KFLEV)
     4808      REAL(KIND=8) ZDISD(KDLON,KFLEV+1)
     4809      REAL(KIND=8) ZDISU(KDLON,KFLEV+1)
    49884810C
    49894811      INTEGER jk, jl
    … …  
    50764898      INTEGER KUAER,KTRAER, KLIM
    50774899C
    5078       REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS
    5079       REAL*8 PADJD(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS
    5080       REAL*8 PADJU(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS
    5081       REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
    5082       REAL*8 PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS
    5083       REAL*8 PBSUR(KDLON,Ninter) ! SPECTRAL SURFACE PLANCK FUNCTION
    5084       REAL*8 PBSUI(KDLON) ! SURFACE PLANCK FUNCTION
    5085       REAL*8 PBTOP(KDLON,Ninter) ! SPECTRAL T.O.A. PLANCK FUNCTION
    5086       REAL*8 PDISD(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS
    5087       REAL*8 PDISU(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS
    5088       REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY
    5089       REAL*8 PPMB(KDLON,KFLEV+1) ! PRESSURE MB
    5090       REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
    5091       REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
    5092       REAL*8 PGASUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
    5093       REAL*8 PGBSUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
    5094       REAL*8 PGATOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
    5095       REAL*8 PGBTOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
    5096 C
    5097       REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
    5098       REAL*8 PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM
     4900      REAL(KIND=8) PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS
     4901      REAL(KIND=8) PADJD(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS
     4902      REAL(KIND=8) PADJU(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS
     4903      REAL(KIND=8) PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
     4904      REAL(KIND=8) PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS
     4905      REAL(KIND=8) PBSUR(KDLON,Ninter) ! SPECTRAL SURFACE PLANCK FUNCTION
     4906      REAL(KIND=8) PBSUI(KDLON) ! SURFACE PLANCK FUNCTION
     4907      REAL(KIND=8) PBTOP(KDLON,Ninter) ! SPECTRAL T.O.A. PLANCK FUNCTION
     4908      REAL(KIND=8) PDISD(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS
     4909      REAL(KIND=8) PDISU(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS
     4910      REAL(KIND=8) PEMIS(KDLON) ! SURFACE EMISSIVITY
     4911      REAL(KIND=8) PPMB(KDLON,KFLEV+1) ! PRESSURE MB
     4912      REAL(KIND=8) PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
     4913      REAL(KIND=8) PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
     4914      REAL(KIND=8) PGASUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
     4915      REAL(KIND=8) PGBSUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
     4916      REAL(KIND=8) PGATOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
     4917      REAL(KIND=8) PGBTOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
     4918C
     4919      REAL(KIND=8) PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
     4920      REAL(KIND=8) PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM
    50994921C
    51004922C* LOCAL VARIABLES:
    51014923C
    5102       REAL*8 ZBGND(KDLON)
    5103       REAL*8 ZFD(KDLON)
    5104       REAL*8  ZFN10(KDLON)
    5105       REAL*8 ZFU(KDLON)
    5106       REAL*8  ZTT(KDLON,NTRA)
    5107       REAL*8 ZTT1(KDLON,NTRA)
    5108       REAL*8 ZTT2(KDLON,NTRA)
    5109       REAL*8  ZUU(KDLON,NUA)
    5110       REAL*8 ZCNSOL(KDLON)
    5111       REAL*8 ZCNTOP(KDLON)
     4924      REAL(KIND=8) ZBGND(KDLON)
     4925      REAL(KIND=8) ZFD(KDLON)
     4926      REAL(KIND=8)  ZFN10(KDLON)
     4927      REAL(KIND=8) ZFU(KDLON)
     4928      REAL(KIND=8)  ZTT(KDLON,NTRA)
     4929      REAL(KIND=8) ZTT1(KDLON,NTRA)
     4930      REAL(KIND=8) ZTT2(KDLON,NTRA)
     4931      REAL(KIND=8)  ZUU(KDLON,NUA)
     4932      REAL(KIND=8) ZCNSOL(KDLON)
     4933      REAL(KIND=8) ZCNTOP(KDLON)
    51124934C
    51134935      INTEGER jk, jl, ja
    51144936      INTEGER jstra, jstru
    51154937      INTEGER ind1, ind2, ind3, ind4, in, jlim
    5116       REAL*8 zctstr
     4938      REAL(KIND=8) zctstr
    51174939C-----------------------------------------------------------------------
    51184940C
    … …  
    54015223      INTEGER KUAER,KTRAER
    54025224C
    5403       REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS
    5404       REAL*8 PDBDT(KDLON,Ninter,KFLEV) ! LAYER PLANCK FUNCTION GRADIENT
    5405       REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
    5406       REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
    5407 C
    5408       REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! ENERGY EXCHANGE MATRIX
    5409       REAL*8 PDISD(KDLON,KFLEV+1) !  CONTRIBUTION BY DISTANT LAYERS
    5410       REAL*8 PDISU(KDLON,KFLEV+1) !  CONTRIBUTION BY DISTANT LAYERS
     5225      REAL(KIND=8) PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS
     5226      REAL(KIND=8) PDBDT(KDLON,Ninter,KFLEV) ! LAYER PLANCK FUNCTION GRADIENT
     5227      REAL(KIND=8) PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
     5228      REAL(KIND=8) PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
     5229C
     5230      REAL(KIND=8) PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! ENERGY EXCHANGE MATRIX
     5231      REAL(KIND=8) PDISD(KDLON,KFLEV+1) !  CONTRIBUTION BY DISTANT LAYERS
     5232      REAL(KIND=8) PDISU(KDLON,KFLEV+1) !  CONTRIBUTION BY DISTANT LAYERS
    54115233C
    54125234C* LOCAL VARIABLES:
    54135235C
    5414       REAL*8 ZGLAYD(KDLON)
    5415       REAL*8 ZGLAYU(KDLON)
    5416       REAL*8 ZTT(KDLON,NTRA)
    5417       REAL*8 ZTT1(KDLON,NTRA)
    5418       REAL*8 ZTT2(KDLON,NTRA)
     5236      REAL(KIND=8) ZGLAYD(KDLON)
     5237      REAL(KIND=8) ZGLAYU(KDLON)
     5238      REAL(KIND=8) ZTT(KDLON,NTRA)
     5239      REAL(KIND=8) ZTT1(KDLON,NTRA)
     5240      REAL(KIND=8) ZTT2(KDLON,NTRA)
    54195241C
    54205242      INTEGER jl, jk, ja, ikp1, ikn, ikd1, jkj, ikd2
    54215243      INTEGER ikjp1, ikm1, ikj, jlk, iku1, ijkl, iku2
    54225244      INTEGER ind1, ind2, ind3, ind4, itt
    5423       REAL*8 zww, zdzxdg, zdzxmg
     5245      REAL(KIND=8) zww, zdzxdg, zdzxmg
    54245246C
    54255247C*         1.    INITIALIZATION
    … …  
    56195441     S  , PADJD,PADJU,PCNTRB,PDBDT)
    56205442       USE dimphy
     5443      USE radiation_AR4_param, only : WG1
    56215444      IMPLICIT none
    56225445cym#include "dimensions.h"
    … …  
    56565479      INTEGER KUAER,KTRAER
    56575480C
    5658       REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS
    5659       REAL*8 PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
    5660       REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
    5661       REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
    5662 C
    5663       REAL*8 PADJD(KDLON,KFLEV+1) ! CONTRIBUTION OF ADJACENT LAYERS
    5664       REAL*8 PADJU(KDLON,KFLEV+1) ! CONTRIBUTION OF ADJACENT LAYERS
    5665       REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
    5666       REAL*8 PDBDT(KDLON,Ninter,KFLEV) !  LAYER PLANCK FUNCTION GRADIENT
     5481      REAL(KIND=8) PABCU(KDLON,NUA,3*KFLEV+1) ! ABSORBER AMOUNTS
     5482      REAL(KIND=8) PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
     5483      REAL(KIND=8) PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
     5484      REAL(KIND=8) PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
     5485C
     5486      REAL(KIND=8) PADJD(KDLON,KFLEV+1) ! CONTRIBUTION OF ADJACENT LAYERS
     5487      REAL(KIND=8) PADJU(KDLON,KFLEV+1) ! CONTRIBUTION OF ADJACENT LAYERS
     5488      REAL(KIND=8) PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
     5489      REAL(KIND=8) PDBDT(KDLON,Ninter,KFLEV) !  LAYER PLANCK FUNCTION GRADIENT
    56675490C
    56685491C* LOCAL ARRAYS:
    56695492C
    5670       REAL*8 ZGLAYD(KDLON)
    5671       REAL*8 ZGLAYU(KDLON)
    5672       REAL*8 ZTT(KDLON,NTRA)
    5673       REAL*8 ZTT1(KDLON,NTRA)
    5674       REAL*8 ZTT2(KDLON,NTRA)
    5675       REAL*8 ZUU(KDLON,NUA)
     5493      REAL(KIND=8) ZGLAYD(KDLON)
     5494      REAL(KIND=8) ZGLAYU(KDLON)
     5495      REAL(KIND=8) ZTT(KDLON,NTRA)
     5496      REAL(KIND=8) ZTT1(KDLON,NTRA)
     5497      REAL(KIND=8) ZTT2(KDLON,NTRA)
     5498      REAL(KIND=8) ZUU(KDLON,NUA)
    56765499C
    56775500      INTEGER jk, jl, ja, im12, ind, inu, ixu, jg
    56785501      INTEGER ixd, ibs, idd, imu, jk1, jk2, jnu
    5679       REAL*8 zwtr
     5502      REAL(KIND=8) zwtr
    56805503c
    5681 C* Data Block:
    5682 c
    5683       REAL*8 WG1(2)
    5684       SAVE WG1
    5685 c$OMP THREADPRIVATE(WG1)
    5686       DATA (WG1(jk),jk=1,2) /1.0, 1.0/
     5504
    56875505C-----------------------------------------------------------------------
    56885506C
    … …  
    58655683C
    58665684C-----------------------------------------------------------------------
    5867       REAL*8 O1H, O2H
     5685      REAL(KIND=8) O1H, O2H
    58685686      PARAMETER (O1H=2230.)
    58695687      PARAMETER (O2H=100.)
    5870       REAL*8 RPIALF0
     5688      REAL(KIND=8) RPIALF0
    58715689      PARAMETER (RPIALF0=2.0)
    58725690C
    58735691C* ARGUMENTS:
    58745692C
    5875       REAL*8 PUU(KDLON,NUA)
    5876       REAL*8 PTT(KDLON,NTRA)
    5877       REAL*8 PGA(KDLON,8,2)
    5878       REAL*8 PGB(KDLON,8,2)
     5693      REAL(KIND=8) PUU(KDLON,NUA)
     5694      REAL(KIND=8) PTT(KDLON,NTRA)
     5695      REAL(KIND=8) PGA(KDLON,8,2)
     5696      REAL(KIND=8) PGB(KDLON,8,2)
    58795697C
    58805698C* LOCAL VARIABLES:
    58815699C
    5882       REAL*8 zz, zxd, zxn
    5883       REAL*8 zpu, zpu10, zpu11, zpu12, zpu13
    5884       REAL*8 zeu, zeu10, zeu11, zeu12, zeu13
    5885       REAL*8 zx, zy, zsq1, zsq2, zvxy, zuxy
    5886       REAL*8 zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o
    5887       REAL*8 zsqn21, zodn21, zsqh42, zodh42
    5888       REAL*8 zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12
    5889       REAL*8 zuu11, zuu12, za11, za12
     5700      REAL(KIND=8) zz, zxd, zxn
     5701      REAL(KIND=8) zpu, zpu10, zpu11, zpu12, zpu13
     5702      REAL(KIND=8) zeu, zeu10, zeu11, zeu12, zeu13
     5703      REAL(KIND=8) zx, zy, zsq1, zsq2, zvxy, zuxy
     5704      REAL(KIND=8) zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o
     5705      REAL(KIND=8) zsqn21, zodn21, zsqh42, zodh42
     5706      REAL(KIND=8) zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12
     5707      REAL(KIND=8) zuu11, zuu12, za11, za12
    58905708      INTEGER jl, ja
    58915709C     ------------------------------------------------------------------
    … …  
    58975715C
    58985716C
     5717!cdir collapse
    58995718      DO 130 JA = 1 , 8
    59005719      DO 120 JL = 1, KDLON
    … …  
    60415860C
    60425861C-----------------------------------------------------------------------
    6043       REAL*8 O1H, O2H
     5862      REAL(KIND=8) O1H, O2H
    60445863      PARAMETER (O1H=2230.)
    60455864      PARAMETER (O2H=100.)
    6046       REAL*8 RPIALF0
     5865      REAL(KIND=8) RPIALF0
    60475866      PARAMETER (RPIALF0=2.0)
    60485867C
    60495868C* ARGUMENTS:
    60505869C
    6051       REAL*8 PGA(KDLON,8,2) ! PADE APPROXIMANTS
    6052       REAL*8 PGB(KDLON,8,2) ! PADE APPROXIMANTS
    6053       REAL*8 PUU1(KDLON,NUA) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 1
    6054       REAL*8 PUU2(KDLON,NUA) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 2
    6055       REAL*8 PTT(KDLON,NTRA) ! TRANSMISSION FUNCTIONS
     5870      REAL(KIND=8) PGA(KDLON,8,2) ! PADE APPROXIMANTS
     5871      REAL(KIND=8) PGB(KDLON,8,2) ! PADE APPROXIMANTS
     5872      REAL(KIND=8) PUU1(KDLON,NUA) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 1
     5873      REAL(KIND=8) PUU2(KDLON,NUA) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 2
     5874      REAL(KIND=8) PTT(KDLON,NTRA) ! TRANSMISSION FUNCTIONS
    60565875C
    60575876C* LOCAL VARIABLES:
    60585877C
    60595878      INTEGER ja, jl
    6060       REAL*8 zz, zxd, zxn
    6061       REAL*8 zpu, zpu10, zpu11, zpu12, zpu13
    6062       REAL*8 zeu, zeu10, zeu11, zeu12, zeu13
    6063       REAL*8 zx, zy, zuxy, zsq1, zsq2, zvxy, zaercn, zto1, zto2
    6064       REAL*8 zxch4, zych4, zsqh41, zodh41
    6065       REAL*8 zxn2o, zyn2o, zsqn21, zodn21, zsqh42, zodh42
    6066       REAL*8 zsqn22, zodn22, za11, zttf11, za12, zttf12
    6067       REAL*8 zuu11, zuu12
     5879      REAL(KIND=8) zz, zxd, zxn
     5880      REAL(KIND=8) zpu, zpu10, zpu11, zpu12, zpu13
     5881      REAL(KIND=8) zeu, zeu10, zeu11, zeu12, zeu13
     5882      REAL(KIND=8) zx, zy, zuxy, zsq1, zsq2, zvxy, zaercn, zto1, zto2
     5883      REAL(KIND=8) zxch4, zych4, zsqh41, zodh41
     5884      REAL(KIND=8) zxn2o, zyn2o, zsqn21, zodn21, zsqh42, zodh42
     5885      REAL(KIND=8) zsqn22, zodn22, za11, zttf11, za12, zttf12
     5886      REAL(KIND=8) zuu11, zuu12
    60685887C     ------------------------------------------------------------------
    60695888C
    … …  
    60745893C
    60755894C
     5895
     5896!CDIR ON_ADB(PUU1)
     5897!CDIR ON_ADB(PUU2)
     5898!CDIR COLLAPSE
    60765899      DO 130 JA = 1 , 8
    60775900      DO 120 JL = 1, KDLON

  • LMDZ4/trunk/libf/phylmd/surf_land_orchidee_mod.F90

    r1146 r1279  
    4040       tsol_rad, tsurf_new, alb1_new, alb2_new, &
    4141       emis_new, z0_new, qsurf)
    42    USE mod_surf_para
    43    USE mod_synchro_omp
     42
     43    USE mod_surf_para
     44    USE mod_synchro_omp
    4445   
     46USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_land_inst, fco2_lu_inst
     47
    4548!   
    4649! Cette routine sert d'interface entre le modele atmospherique et le
    … …  
    6770!   spechum      humidite specifique 1ere couche
    6871!   epot_air     temp pot de l'air
    69 !   ccanopy      concentration CO2 canopee
     72!   ccanopy      concentration CO2 canopee, correspond au co2_send de
     73!                carbon_cycle_mod ou valeur constant co2_ppm
    7074!   tq_cdrag     cdrag
    7175!   petAcoef     coeff. A de la resolution de la CL pour t
    … …  
    134138    INTEGER                                   :: error
    135139    REAL, DIMENSION(klon)                     :: swdown_vrai
     140    REAL, DIMENSION(klon)                     :: fco2_land_comp  ! sur grille compresse
     141    REAL, DIMENSION(klon)                     :: fco2_lu_comp    ! sur grille compresse
    136142    CHARACTER (len = 20)                      :: modname = 'surf_land_orchidee'
    137143    CHARACTER (len = 80)                      :: abort_message
    … …  
    341347          CALL abort_gcm(modname,abort_message,1)
    342348       ENDIF
    343 
     349!
     350! Allocate variables needed for carbon_cycle_mod
     351!
     352       IF (carbon_cycle_cpl) THEN
     353          IF (.NOT. ALLOCATED(fco2_land_inst)) THEN
     354             ALLOCATE(fco2_land_inst(klon),stat=error)
     355             IF (error /= 0)  CALL abort_gcm(modname,'Pb in allocation fco2_land_inst',1)
     356             
     357             ALLOCATE(fco2_lu_inst(klon),stat=error)
     358             IF(error /=0) CALL abort_gcm(modname,'Pb in allocation fco2_lu_inst',1)
     359          END IF
     360       END IF
     361       
    344362    ENDIF                          ! (fin debut)
     363 
    345364
    346365!
    … …  
    443462   
    444463    IF (debut) CALL Finalize_surf_para
    445    
     464
     465   
     466! JG : TEMPORAIRE!!!! Les variables fco2_land_comp et fco2_lu_comp seront plus tard en sortie d'ORCHIDEE
     467!      ici mis a valeur quelquonque pour test. Ces variables sont sur la grille compresse avec uniquement des points de terres
     468
     469    fco2_land_comp(:) = 1.
     470    fco2_lu_comp(:)   = 10.
     471
     472! Decompress variables for the module carbon_cycle_mod
     473    IF (carbon_cycle_cpl) THEN
     474       fco2_land_inst(:)=0.
     475       fco2_lu_inst(:)=0.
     476       
     477       DO igrid = 1, knon
     478          ireal = knindex(igrid)
     479          fco2_land_inst(ireal) = fco2_land_comp(igrid)
     480          fco2_lu_inst(ireal)   = fco2_lu_comp(igrid)
     481       END DO
     482    END IF
     483
    446484  END SUBROUTINE surf_land_orchidee
    447485!

  • LMDZ4/trunk/libf/phylmd/surf_land_orchidee_noopenmp_mod.F90

    r1146 r1279  
    6868!   spechum      humidite specifique 1ere couche
    6969!   epot_air     temp pot de l'air
    70 !   ccanopy      concentration CO2 canopee
     70!   ccanopy      concentration CO2 canopee, correspond au co2_send de
     71!                carbon_cycle_mod ou valeur constant co2_ppm
    7172!   tq_cdrag     cdrag
    7273!   petAcoef     coeff. A de la resolution de la CL pour t
    … …  
    9596!   qsurf        air moisture at surface
    9697!
     98    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_land_inst, fco2_lu_inst
     99    IMPLICIT NONE
     100
    97101    INCLUDE "indicesol.h"
    98102    INCLUDE "temps.h"
    … …  
    135139    INTEGER                                   :: error
    136140    REAL, DIMENSION(klon)                     :: swdown_vrai
     141    REAL, DIMENSION(klon)                     :: fco2_land_comp  ! sur grille compresse
     142    REAL, DIMENSION(klon)                     :: fco2_lu_comp    ! sur grille compresse
    137143    CHARACTER (len = 20)                      :: modname = 'surf_land_orchidee'
    138144    CHARACTER (len = 80)                      :: abort_message
    … …  
    334340       ENDIF
    335341
     342!
     343! Allocate variables needed for carbon_cycle_mod
     344!
     345       IF (carbon_cycle_cpl) THEN
     346          IF (.NOT. ALLOCATED(fco2_land_inst)) THEN
     347             ALLOCATE(fco2_land_inst(klon),stat=error)
     348             IF (error /= 0)  CALL abort_gcm(modname,'Pb in allocation fco2_land_inst',1)
     349             
     350             ALLOCATE(fco2_lu_inst(klon),stat=error)
     351             IF(error /=0) CALL abort_gcm(modname,'Pb in allocation fco2_lu_inst',1)
     352          END IF
     353       END IF
     354
    336355    ENDIF                          ! (fin debut)
    337356
    … …  
    378397
    379398#ifndef CPP_MPI
    380 #define ORC_PREPAR
    381 #endif
    382 
    383 #ifdef ORC_PREPAR
    384399          ! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
    385400          CALL intersurf_main (itime+itau_phy-1, iim, jjm+1, knon, ktindex, dtime, &
    … …  
    394409
    395410#else         
    396           ! Interface for ORCHIDEE version 1.9 or later compiled in parallel mode(with preprocessing flag CPP_MPI)
     411          ! Interface for ORCHIDEE version 1.9 or later(1.9.2, 1.9.3, 1.9.4) compiled in parallel mode(with preprocessing flag CPP_MPI)
    397412          CALL intersurf_main (itime+itau_phy-1, iim, jjm+1, offset, knon, ktindex, &
    398413               orch_comm, dtime, lrestart_read, lrestart_write, lalo, &
    … …  
    417432    IF (knon /=0) THEN
    418433   
    419 #ifdef ORC_PREPAR
     434#ifndef CPP_MPI
    420435       ! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
    421436       CALL intersurf_main (itime+itau_phy, iim, jjm+1, knon, ktindex, dtime, &
    … …  
    463478
    464479    IF (debut) lrestart_read = .FALSE.
     480
     481
     482! JG : TEMPORAIRE!!!! Les variables fco2_land_comp et fco2_lu_comp seront plus tard en sortie d'ORCHIDEE
     483!      ici mis a valeur quelquonque pour test. Ces variables sont sur la grille compresse avec uniquement des points de terres
     484
     485    fco2_land_comp(:) = 1.
     486    fco2_lu_comp(:)   = 10.
     487
     488! Decompress variables for the module carbon_cycle_mod
     489    IF (carbon_cycle_cpl) THEN
     490       fco2_land_inst(:)=0.
     491       fco2_lu_inst(:)=0.
     492       
     493       DO igrid = 1, knon
     494          ireal = knindex(igrid)
     495          fco2_land_inst(ireal) = fco2_land_comp(igrid)
     496          fco2_lu_inst(ireal)   = fco2_lu_comp(igrid)
     497       END DO
     498    END IF
     499
    465500#endif   
    466501  END SUBROUTINE surf_land_orchidee
    … …  
    628663          displs(i)=displs(i-1)+knon_nb(i-1)
    629664       ENDDO
    630     ENDIF
     665   ELSE
     666       ALLOCATE(neighbours_g(1,8))
     667   ENDIF
    631668   
    632669    ktindex_p(1:knon)=ktindex(1:knon)+klon_mpi_begin-1+iim-1

  • LMDZ4/trunk/libf/phylmd/undefSTD.F

    r1233 r1279  
    1414c
    1515c Calcul * du nombre de pas de temps (FLOAT(ecrit_XXX)-tnondef))
    16 c          ou la variable tlevSTD est bien definie (.NE.missing_val),
     16c          ou la variable tlevSTD est bien definie (.NE.1.E+20),
    1717c et
    1818c        * de la somme de tlevSTD => tsumSTD
    … …  
    3333cym#include "dimphy.h"
    3434c variables Input
     35c
    3536      INTEGER nlevSTD, klevSTD, itap
    3637      PARAMETER(klevSTD=17)

  • LMDZ4/trunk/libf/phylmd/write_histrac.h

    r1146 r1279  
     1!$Id $
     2!***************************************
     3!  ECRITURE DU FICHIER :  histrac.nc
     4!***************************************
     5  IF (ecrit_tra > 0. .AND. config_inca == 'none') THEN
     6     
     7     itau_w = itau_phy + nstep
     8     
     9     CALL histwrite_phy(nid_tra,"phis",itau_w,pphis)
     10     CALL histwrite_phy(nid_tra,"aire",itau_w,airephy)
     11
     12!TRACEURS
     13!----------------
     14     DO it=1,nbtr
     15        iiq=niadv(it+2)
     16
     17! CONCENTRATIONS
     18        CALL histwrite_phy(nid_tra,tname(iiq),itau_w,tr_seri(:,:,it))
     19
     20! TD LESSIVAGE       
     21        IF (lessivage .AND. aerosol(it)) THEN
     22           CALL histwrite_phy(nid_tra,"fl"//tname(iiq),itau_w,flestottr(:,:,it))
     23        ENDIF
     24
     25! TD THERMIQUES
     26        IF (iflag_thermals.gt.0) THEN
     27           CALL histwrite_phy(nid_tra,"d_tr_th_"//tname(iiq),itau_w,d_tr_th(:,:,it))
     28        ENDIF
     29
     30! TD CONVECTION
     31        IF (iflag_con.GE.2) THEN
     32           CALL histwrite_phy(nid_tra,"d_tr_cv_"//tname(iiq),itau_w,d_tr_cv(:,:,it))
     33        ENDIF
     34
     35! TD COUCHE-LIMITE
     36        CALL histwrite_phy(nid_tra,"d_tr_cl_"//tname(iiq),itau_w,d_tr_cl(:,:,it))
     37     ENDDO
     38!---------------
    139!
    2 ! $Header$
    340!
     41! VENT (niveau 1)   
     42     CALL histwrite_phy(nid_tra,"pyu1",itau_w,yu1)
     43     CALL histwrite_phy(nid_tra,"pyv1",itau_w,yv1)
     44!
     45! TEMPERATURE DU SOL
     46     zx_tmp_fi2d(:)=ftsol(:,1)         
     47     CALL histwrite_phy(nid_tra,"ftsol1",itau_w,zx_tmp_fi2d)
     48     zx_tmp_fi2d(:)=ftsol(:,2)
     49     CALL histwrite_phy(nid_tra,"ftsol2",itau_w,zx_tmp_fi2d)
     50     zx_tmp_fi2d(:)=ftsol(:,3)
     51     CALL histwrite_phy(nid_tra,"ftsol3",itau_w,zx_tmp_fi2d)
     52     zx_tmp_fi2d(:)=ftsol(:,4)
     53     CALL histwrite_phy(nid_tra,"ftsol4",itau_w,zx_tmp_fi2d)
     54!     
     55! NATURE DU SOL
     56     zx_tmp_fi2d(:)=pctsrf(:,1)
     57     CALL histwrite_phy(nid_tra,"psrf1",itau_w,zx_tmp_fi2d)
     58     zx_tmp_fi2d(:)=pctsrf(:,2)
     59     CALL histwrite_phy(nid_tra,"psrf2",itau_w,zx_tmp_fi2d)
     60     zx_tmp_fi2d(:)=pctsrf(:,3)
     61     CALL histwrite_phy(nid_tra,"psrf3",itau_w,zx_tmp_fi2d)
     62     zx_tmp_fi2d(:)=pctsrf(:,4)
     63     CALL histwrite_phy(nid_tra,"psrf4",itau_w,zx_tmp_fi2d)
     64 
     65! DIVERS   
     66     CALL histwrite_phy(nid_tra,"pplay",itau_w,pplay)     
     67     CALL histwrite_phy(nid_tra,"t",itau_w,t_seri)     
     68     CALL histwrite_phy(nid_tra,"mfu",itau_w,pmfu)
     69     CALL histwrite_phy(nid_tra,"mfd",itau_w,pmfd)
     70     CALL histwrite_phy(nid_tra,"en_u",itau_w,pen_u)
     71     CALL histwrite_phy(nid_tra,"en_d",itau_w,pen_d)
     72     CALL histwrite_phy(nid_tra,"de_d",itau_w,pde_d)
     73     CALL histwrite_phy(nid_tra,"de_u",itau_w,pde_u)
     74     CALL histwrite_phy(nid_tra,"coefh",itau_w,coefh)
    475
    5       IF (ecrit_tra>0. .AND. config_inca == 'none') THEN
    6       ndex = 0
    7       ndex2d = 0
    8       ndex3d = 0
    9 c
    10       itau_w = itau_phy + nstep
     76     IF (ok_sync) THEN
     77!$OMP MASTER
     78        CALL histsync(nid_tra)
     79!$OMP END MASTER
     80     ENDIF
    1181
    12       CALL histwrite_phy(nid_tra,"phis",itau_w,pphis)
    13 C
    14       CALL histwrite_phy(nid_tra,"aire",itau_w,airephy)
     82  ENDIF !ecrit_tra>0. .AND. config_inca == 'none'
    1583
    16       DO it=1,nbtr
    17        iiq=niadv(it+2)
    18 
    19        CALL histwrite_phy(nid_tra,tname(iiq),itau_w,tr_seri(:,:,it))
    20        if (lessivage) THEN
    21        CALL histwrite_phy(nid_tra,"fl"//tname(iiq),itau_w,
    22      .                                   flestottr(:,:,it))
    23       endif
    24      
    25 c----Olivia
    26        CALL histwrite_phy(nid_tra,"d_tr_th_"//tname(iiq),itau_w,
    27      .                                           d_tr_th(:,:,it))
    28 
    29          if(iflag_con.GE.2) then
    30        CALL histwrite_phy(nid_tra,"d_tr_cv_"//tname(iiq),itau_w,
    31      .                                           d_tr_cv(:,:,it))
    32          endif !(iflag_con.GE.2) then
    33        CALL histwrite_phy(nid_tra,"d_tr_cl_"//tname(iiq),itau_w,
    34      .                                           d_tr_cl(:,:,it))
    35 c---fin Olivia     
    36      
    37       ENDDO
    38 
    39 
    40 C abder
    41          CALL histwrite_phy(nid_tra,"pyu1",itau_w,yu1)
    42 
    43          CALL histwrite_phy(nid_tra,"pyv1",itau_w,yv1)
    44 
    45          CALL histwrite_phy(nid_tra,"ftsol1",itau_w,pftsol1)
    46 
    47          CALL histwrite_phy(nid_tra,"ftsol2",itau_w,pftsol2)
    48 
    49          CALL histwrite_phy(nid_tra,"ftsol3",itau_w,pftsol3)
    50 
    51          CALL histwrite_phy(nid_tra,"ftsol4",itau_w,pftsol4)
    52 
    53          CALL histwrite_phy(nid_tra,"psrf1",itau_w,ppsrf1)
    54 
    55          CALL histwrite_phy(nid_tra,"psrf2",itau_w,ppsrf2)
    56 
    57          CALL histwrite_phy(nid_tra,"psrf3",itau_w,ppsrf3)
    58 
    59          CALL histwrite_phy(nid_tra,"psrf4",itau_w,ppsrf4)
    60         CALL histwrite_phy(nid_tra,"pplay",itau_w,pplay)
    61 
    62         CALL histwrite_phy(nid_tra,"t",itau_w,t_seri)
    63         CALL histwrite_phy(nid_tra,"mfu",itau_w,pmfu)
    64         CALL histwrite_phy(nid_tra,"mfd",itau_w,pmfd)
    65         CALL histwrite_phy(nid_tra,"en_u",itau_w,pen_u)
    66         CALL histwrite_phy(nid_tra,"en_d",itau_w,pen_d)
    67         CALL histwrite_phy(nid_tra,"de_d",itau_w,pde_d)
    68         CALL histwrite_phy(nid_tra,"de_u",itau_w,pde_u)
    69         CALL histwrite_phy(nid_tra,"coefh",itau_w,coefh)
    70 
    71 
    72 c abder
    73 
    74       if (ok_sync) then
    75 c$OMP MASTER
    76         call histsync(nid_tra)
    77 c$OMP END MASTER
    78        endif
    79 
    80        END IF !ecrit_tra>0. .AND. config_inca == 'none'
    81 
    82 
    83 
Note: See TracChangeset for help on using the changeset viewer.