Changeset 320


Ignore:
Timestamp:
Jan 25, 2002, 5:20:10 PM (22 years ago)
Author:
lmdzadmin
Message:

Adaptation à la version couplée
LF

Location:
LMDZ.3.3/branches/rel-LF/libf/dyn3d
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/create_etat0_limit.F

    r315 r320  
    1313c     oldice   = .T. si l'on veut garder les anciennes glaces , obtenues
    1414c     par  grille_m  ( grid_atob ) .
    15 
     15c
     16c     on cree le masque dans etat0 que l'on passe ensuite dans limit pour
     17c     garder les cohérences
    1618
    1719      LOGICAL interbar, extrap , oldice
    1820      PARAMETER ( interbar = .TRUE. , extrap = .FALSE. , oldice=.TRUE.)
     21#include "dimensions.h"
     22#include "paramet.h"
     23      REAL :: masque(iip1,jjp1)
    1924
    20       CALL etat0_netcdf ( interbar )
     25      CALL etat0_netcdf ( interbar, masque )
    2126c
    2227      WRITE(6,1)
    … …  
    2631      WRITE(6,1)
    2732c
    28       CALL  limit_netcdf ( interbar, extrap , oldice )
     33      CALL  limit_netcdf ( interbar, extrap , oldice, masque )
    2934
    30351     FORMAT(//)

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/etat0_netcdf.F

    r278 r320  
    1       SUBROUTINE etat0_netcdf
     1c
     2c $Header$
     3c
     4      SUBROUTINE etat0_netcdf (interbar, masque)
    25   
    36      USE startvar
    … …  
    1114      !
    1215      !
    13 c      INTEGER, PARAMETER :: KIDIA=1, KFDIA=iim*(jjm-1)+2,
    14 c     .KLON=KFDIA-KIDIA+1,KLEV=llm
     16!      INTEGER, PARAMETER :: KIDIA=1, KFDIA=iim*(jjm-1)+2,
     17!     .KLON=KFDIA-KIDIA+1,KLEV=llm
    1518      !
    1619#include "comgeom2.h"
    … …  
    2124#include "dimsoil.h"
    2225      !
     26      LOGICAL interbar
    2327      REAL :: latfi(klon), lonfi(klon)
    2428      REAL :: orog(iip1,jjp1), rugo(iip1,jjp1), masque(iip1,jjp1),
    … …  
    5660      CHARACTER*80 :: varname
    5761      !
    58       INTEGER :: i,j, ig, l, ji
     62      INTEGER :: i,j, ig, l, ji,ii1,ii2
    5963      REAL :: xpi
    6064      !
    … …  
    8791      REAL ::phystep,co2_ppm,solaire
    8892      INTEGER :: radpas
     93       real zrel(iip1*jjp1),chmin,chmax
    8994
    9095      CHARACTER*80 :: visu_file
    … …  
    156161      ! This line needs to be replaced by a call to restget to get the values in the restart file
    157162      orog(:,:) = 0.0
    158        CALL startget(varname, iip1, jjp1, rlonv, rlatu, orog, 0.0)
     163       CALL startget(varname, iip1, jjp1, rlonv, rlatu, orog, 0.0 ,
     164     , jjm ,rlonu,rlatv , interbar )
    159165      !
    160166      WRITE(*,*) 'OUT OF GET VARIABLE : Relief'
    … …  
    164170      ! This line needs to be replaced by a call to restget to get the values in the restart file
    165171      rugo(:,:) = 0.0
    166        CALL startget(varname, iip1, jjp1, rlonv, rlatu, rugo, 0.0)
     172       CALL startget(varname, iip1, jjp1, rlonv, rlatu, rugo, 0.0 ,
     173     , jjm, rlonu,rlatv , interbar )
    167174      !
    168175      WRITE(*,*) 'OUT OF GET VARIABLE : Rugosite'
    … …  
    172179      ! This line needs to be replaced by a call to restget to get the values in the restart file
    173180      masque(:,:) = 0.0
    174        CALL startget(varname, iip1, jjp1, rlonv, rlatu, masque, 0.0)
     181       CALL startget(varname, iip1, jjp1, rlonv, rlatu, masque, 0.0,
     182     , jjm ,rlonu,rlatv , interbar )
    175183      !
    176184      WRITE(*,*) 'MASQUE construit : Masque'
    … …  
    187195      varname = 'zmasq'
    188196      zmasq(:) = 0.
    189       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmasq,0.0)
     197      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmasq,0.0,
     198     , jjm ,rlonu,rlatv , interbar )
    190199      WHERE (zmasq(1 : klon) .LT. EPSFRA)
    191200          zmasq(1 : klon) = 0.
    … …  
    201210      varname = 'psol'
    202211      psol(:,:) = 0.0
    203       CALL startget(varname, iip1, jjp1, rlonv, rlatu, psol, 0.0)
     212      CALL startget(varname, iip1, jjp1, rlonv, rlatu, psol, 0.0 ,
     213     , jjm ,rlonu,rlatv , interbar )
    204214      !
    205215      !  Compute here the pressure on the intermediate levels. One would expect that this is available in the GCM
    … …  
    229239      varname = 'surfgeo'
    230240      phis(:,:) = 0.0
    231       CALL startget(varname, iip1, jjp1, rlonv, rlatu, phis, 0.0)
    232       write(*,*) 'Phis = '
    233       write(*,*)phis
     241      CALL startget(varname, iip1, jjp1, rlonv, rlatu, phis, 0.0 ,
     242     , jjm ,rlonu,rlatv, interbar )
    234243      !
    235244      varname = 'u'
    236245      uvent(:,:,:) = 0.0
    237246      CALL startget(varname, iip1, jjp1, rlonu, rlatu, llm, pls,
    238      . workvar, uvent, 0.0)
     247     . workvar, uvent, 0.0, jjm ,rlonv, rlatv, interbar )
    239248      ! 
    240249      varname = 'v'
    241250      vvent(:,:,:) = 0.0
    242251      CALL startget(varname, iip1, jjm, rlonv, rlatv, llm, pls,
    243      . workvar, vvent, 0.0)
     252     . workvar, vvent, 0.0, jjp1, rlonu, rlatu, interbar )
    244253      !
    245254      varname = 't'
    246255      t3d(:,:,:) = 0.0
    247256      CALL startget(varname, iip1, jjp1, rlonv, rlatu, llm, pls,
    248      . workvar, t3d, 0.0)
     257     . workvar, t3d, 0.0 , jjm, rlonu, rlatv , interbar )
    249258      !
    250259      WRITE(*,*) 'T3D min,max:',minval(t3d(:,:,:)),
    … …  
    253262      tpot(:,:,:) = 0.0
    254263      CALL startget(varname, iip1, jjp1, rlonv, rlatu, llm, pls,
    255      . pk, tpot, 0.0)
     264     . pk, tpot, 0.0 , jjm, rlonu, rlatv , interbar )
    256265      !
    257266      WRITE(*,*) 'T3D min,max:',minval(t3d(:,:,:)),
    … …  
    273282      !
    274283      varname = 'q'
    275       q3d(:,:,:,:) = 0.0
    276284      qd(:,:,:) = 0.0
    277285      q3d(:,:,:,:) = 0.0
    … …  
    279287     .                           maxval(qsat(:,:,:))
    280288      CALL startget(varname, iip1, jjp1, rlonv, rlatu, llm, pls,
    281      . qsat, qd, 0.0)
     289     . qsat, qd, 0.0, jjm, rlonu, rlatv , interbar )
    282290      q3d(:,:,:,1) = qd(:,:,:)
    283291      !
    … …  
    285293      ! This line needs to be replaced by a call to restget to get the values in the restart file
    286294      tsol(:) = 0.0
    287       CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, tsol,0.0)
     295      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, tsol, 0.0,
     296     .    jjm, rlonu, rlatv , interbar )
    288297      !
    289298      WRITE(*,*) 'TSOL construit :'
    … …  
    292301      varname = 'qsol'
    293302      qsol(:) = 0.0
    294       CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, qsol,0.0)
     303      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, qsol, 0.0,
     304     .   jjm, rlonu, rlatv , interbar )
    295305      !
    296306      varname = 'snow'
    297307      sn(:) = 0.0
    298       CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, sn,0.0)
     308      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, sn, 0.0,
     309     .    jjm, rlonu, rlatv , interbar )
    299310      !
    300311      varname = 'rads'
    301312      radsol(:) = 0.0
    302       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,radsol,0.0)
     313      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,radsol,0.0,
     314     .    jjm, rlonu, rlatv , interbar )
    303315      !
    304316      varname = 'deltat'
    305317      deltat(:) = 0.0
    306       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,deltat,0.0)
     318      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,deltat,0.0,
     319     .     jjm, rlonu, rlatv , interbar )
    307320      !
    308321      varname = 'rugmer'
    309322      rugmer(:) = 0.0
    310       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,rugmer,0.0)
     323      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,rugmer,0.0,
     324     .     jjm, rlonu, rlatv , interbar )
    311325      !
    312326      varname = 'agsno'
    313327      agesno(:) = 0.0
    314       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,agesno,0.0)
     328      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,agesno,0.0,
     329     .     jjm, rlonu, rlatv , interbar )
    315330
    316331      varname = 'zmea'
    317332      zmea(:) = 0.0
    318       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0)
     333      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0,
     334     .     jjm, rlonu, rlatv , interbar )
     335
    319336      varname = 'zstd'
    320337      zstd(:) = 0.0
    321       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0)
     338      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0,
     339     .     jjm, rlonu, rlatv , interbar )
    322340      varname = 'zsig'
    323341      zsig(:) = 0.0
    324       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0)
     342      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0,
     343     .     jjm, rlonu, rlatv , interbar )
    325344      varname = 'zgam'
    326345      zgam(:) = 0.0
    327       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0)
     346      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0,
     347     .     jjm, rlonu, rlatv , interbar )
    328348      varname = 'zthe'
    329349      zthe(:) = 0.0
    330       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0)
     350      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0,
     351     .     jjm, rlonu, rlatv , interbar )
    331352      varname = 'zpic'
    332353      zpic(:) = 0.0
    333       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0)
     354      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0,
     355     .     jjm, rlonu, rlatv , interbar )
    334356      varname = 'zval'
    335357      zval(:) = 0.0
    336       CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zval,0.0)
     358      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zval,0.0,
     359     .     jjm, rlonu, rlatv , interbar )
     360c
    337361      rugsrel(:) = 0.0
    338 
     362      IF(ok_orodr)  THEN
     363        DO i = 1, iip1* jjp1
     364         rugsrel(i) = MAX( 1.e-05, zstd(i)* zsig(i) /2. )
     365        ENDDO
     366      ENDIF
    339367C
    340368C En cas de simulation couplee, lecture du masque ocean issu du modele ocean

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/limit_netcdf.F

    r316 r320  
    22C $Header$
    33C
    4       SUBROUTINE limit_netcdf ( interbar, extrap, oldice )
     4      SUBROUTINE limit_netcdf ( interbar, extrap, oldice, masque )
    55c
    66      IMPLICIT none
    … …  
    2828#include "comgeom2.h"
    2929#include "comconst.h"
     30#include "dimphy.h"
    3031c
    3132c-----------------------------------------------------------------------
    … …  
    3334
    3435      INTEGER KIDIA, KFDIA, KLON, KLEV
    35       PARAMETER (KIDIA=1,KFDIA=iim*(jjm-1)+2,
    36      .           KLON=KFDIA-KIDIA+1,KLEV=llm)
    3736c-----------------------------------------------------------------------
    3837      REAL phy_nat(klon,360), phy_nat0(klon)
    … …  
    195194      CALL mask_c_o(imdep, jmdep, dlon_msk, dlat_msk,champ_msk,
    196195     .             iim, jjp1, rlonv, rlatu, champint)
    197       CALL gr_int_dyn(champint, masque, iim, jjp1)
    198       DO i = 1, iim
    199          masque(i,1) = FLOAT(NINT(masque(i,1)))
    200          masque(i,jjp1) = FLOAT(NINT(masque(i,jjp1)))
    201       ENDDO
     196c      CALL gr_int_dyn(champint, masque, iim, jjp1)
     197c      DO i = 1, iim
     198c         masque(i,1) = FLOAT(NINT(masque(i,1)))
     199c         masque(i,jjp1) = FLOAT(NINT(masque(i,jjp1)))
     200c      ENDDO
    202201      DO i = 1, iim
    203202      DO j = 1, jjp1
    … …  
    205204      ENDDO
    206205      ENDDO
    207       CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, phy_nat0)
     206c      CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, phy_nat0)
    208207      ierr = NF_CLOSE(ncid)
    209208c
    … …  
    591590     .                  champan(1,1,k), phy_ice(1,k))
    592591         DO i = 1, klon
    593             phy_nat(i,k) = phy_nat0(i)
     592            phy_nat(i,k) = zmasq(i)
    594593            IF ( (phy_ice(i,k) - 0.5).GE.1.e-5 ) THEN
    595                IF (NINT(phy_nat0(i)).EQ.0) THEN
     594               IF (NINT(zmasq(i)).EQ.0) THEN
    596595                  phy_nat(i,k) = 3.0
    597596               ELSE

  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/startvar.F

    r177 r320  
    1 ! $Header$
     1C
     2C $Header$
     3C
    24      MODULE startvar
    35    !
    … …  
    1113    !
    1214    !        - A 2D variable on the dynamical grid :
    13     !           CALL startget(varname, iml, jml, lon_in, lat_in, champ, val_ex)
    14     !           
     15    !           CALL startget(varname, iml, jml, lon_in, lat_in, champ, val_ex, jml2, lon_in2, lat_in2, interbar )             
    1516    !
    1617    !        - A 1D variable on the physical grid :
    17     !            CALL startget(varname, iml, jml, lon_in, lat_in, nbindex, champ, val_exp)
     18    !            CALL startget(varname, iml, jml, lon_in, lat_in, nbindex, champ, val_exp, jml2, lon_in2, lat_in2, interbar )
    1819    !
    1920    !
    2021    !         - A 3D variable on the dynamical grid :
    21     !            CALL startget(varname, iml, jml, lon_in, lat_in, lml, pls, workvar, champ, val_exp)
     22    !            CALL startget(varname, iml, jml, lon_in, lat_in, lml, pls, workvar, champ, val_exp, jml2, lon_in2, lat_in2, interbar )
    2223    !
    2324    !
    … …  
    5859      REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)  :: lat_phys, lat_rug,
    5960     . lat_alb, lat_rel, lat_dyn
    60       REAL, ALLOCATABLE, SAVE, DIMENSION (:)  :: lev_dyn
     61      REAL, ALLOCATABLE, SAVE, DIMENSION (:)  :: levdyn_ini
    6162      REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)  :: relief, zstd, zsig,
    6263     . zgam, zthe, zpic, zval
    … …  
    7172    !
    7273      SUBROUTINE startget_phys2d(varname, iml, jml, lon_in, lat_in,
    73      . champ, val_exp)
     74     . champ, val_exp, jml2, lon_in2, lat_in2 , interbar )
    7475    !
    7576    !    There is a big mess with the size in logitude, should it be iml or iml+1.
    … …  
    8081    !
    8182      CHARACTER*(*), INTENT(in) :: varname
    82       INTEGER, INTENT(in) :: iml, jml
     83      INTEGER, INTENT(in) :: iml, jml ,jml2
    8384      REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
     85      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
    8486      REAL, INTENT(inout) :: champ(iml,jml)
    8587      REAL, INTENT(in) :: val_exp
     88      LOGICAL interbar
    8689    !
    8790    !   This routine only works if the variable does not exist or is constant
    … …  
    98101                  IF ( .NOT.ALLOCATED(relief)) THEN
    99102                      !
    100                       CALL start_init_orog( iml, jml, lon_in, lat_in)
     103                      CALL start_init_orog( iml, jml, lon_in, lat_in,
     104     .                    jml2,lon_in2,lat_in2, interbar )
    101105                      !
    102106                  ENDIF
    … …  
    118122                  IF ( .NOT.ALLOCATED(rugo)) THEN
    119123                      !
    120                       CALL start_init_orog( iml, jml, lon_in, lat_in)
     124                      CALL start_init_orog( iml, jml, lon_in, lat_in,
     125     .                    jml2,lon_in2,lat_in2 , interbar )
    121126                      !
    122127                  ENDIF
    … …  
    138143                  IF ( .NOT.ALLOCATED(masque)) THEN
    139144                      !
    140                       CALL start_init_orog( iml, jml, lon_in, lat_in)
     145                      CALL start_init_orog( iml, jml, lon_in, lat_in,
     146     .                     jml2,lon_in2,lat_in2 , interbar )
    141147                      !
    142148                  ENDIF
    … …  
    158164                  IF ( .NOT.ALLOCATED(phis)) THEN
    159165                      !
    160                       CALL start_init_orog( iml, jml, lon_in, lat_in)
     166                      CALL start_init_orog( iml, jml, lon_in, lat_in,
     167     .                   jml2,lon_in2, lat_in2 , interbar )
    161168                      !
    162169                  ENDIF
    … …  
    178185                  IF ( .NOT.ALLOCATED(psol_dyn)) THEN
    179186                      !
    180                       CALL start_init_dyn( iml, jml, lon_in, lat_in)
     187                      CALL start_init_dyn( iml, jml, lon_in, lat_in,
     188     .                   jml2,lon_in2, lat_in2 , interbar )
    181189                      !
    182190                  ENDIF
    … …  
    232240    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    233241    !
    234       SUBROUTINE start_init_orog( iml, jml, lon_in, lat_in)
    235     !
    236       INTEGER, INTENT(in) :: iml, jml
     242      SUBROUTINE start_init_orog ( iml,jml,lon_in, lat_in,jml2,lon_in2 ,
     243     ,   lat_in2 , interbar )
     244    !
     245      INTEGER, INTENT(in) :: iml, jml, jml2
    237246      REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
     247      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
     248      LOGICAL interbar
    238249    !
    239250    !  LOCAL
    240251    !
    241       REAL :: lev(1), date, dt
     252      LOGICAL interbar2
     253      REAL :: lev(1), date, dt,chmin,chmax
    242254      INTEGER :: itau(1), fid
    243255      INTEGER ::  llm_tmp, ttm_tmp
    244256      INTEGER :: i, j
    245257      INTEGER :: iret
     258      CHARACTER*25 title
    246259      REAL, ALLOCATABLE :: relief_hi(:,:)
    247260      REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
     261      REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:)
    248262      REAL, ALLOCATABLE :: tmp_var(:,:)
    249263      INTEGER, ALLOCATABLE :: tmp_int(:,:)
    … …  
    275289    !
    276290      ALLOCATE(lon_rad(iml_rel))
     291      ALLOCATE(lon_ini(iml_rel))
     292
    277293      IF ( MAXVAL(lon_rel(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
    278           lon_rad(:) = lon_rel(:,1) * 2.0 * ASIN(1.0) / 180.0
    279       ELSE
    280           lon_rad(:) = lon_rel(:,1)
    281       ENDIF
     294          lon_ini(:) = lon_rel(:,1) * 2.0 * ASIN(1.0) / 180.0
     295      ELSE
     296          lon_ini(:) = lon_rel(:,1)
     297      ENDIF
     298
    282299      ALLOCATE(lat_rad(jml_rel))
     300      ALLOCATE(lat_ini(jml_rel))
     301
    283302      IF ( MAXVAL(lat_rel(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
    284           lat_rad(:) = lat_rel(1,:) * 2.0 * ASIN(1.0) / 180.0
    285       ELSE
    286           lat_rad(:) = lat_rel(1,:)
    287       ENDIF
    288     !
    289     !
     303          lat_ini(:) = lat_rel(1,:) * 2.0 * ASIN(1.0) / 180.0
     304      ELSE
     305          lat_ini(:) = lat_rel(1,:)
     306      ENDIF
     307    !
     308    !
     309
     310      title='RELIEF'
     311
     312      interbar2 = .FALSE.
     313      CALL conf_dat2d(title,iml_rel, jml_rel, lon_ini, lat_ini,
     314     . lon_rad, lat_rad, relief_hi , interbar2  )
     315
    290316      IF ( check ) WRITE(*,*) 'Computes all the parameters needed',
    291317     .' for the gravity wave drag code'
    … …  
    315341    !
    316342      CALL grid_noro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi,
    317      $    iml-1, jml, lon_in, lat_in,
    318     !     . phis, relief, zstd, zsig, zgam, zthe, zpic, zval, tmp_int)
    319     ! PB masque avec % terre mai 2000
    320      $    phis, relief, zstd, zsig, zgam, zthe, zpic, zval, masque)
     343     . iml-1, jml, lon_in, lat_in,
     344     . phis, relief, zstd, zsig, zgam, zthe, zpic, zval, tmp_int)
    321345      phis = phis * 9.81
    322 !      write(*,*)'phis sortie grid_noro'
    323 !      write(*,*)phis
    324     !
    325     !PB supression ligne suivant pour masque avec % terre
    326     !     masque(:,:) = FLOAT(tmp_int(:,:))
     346    !
     347      masque(:,:) = FLOAT(tmp_int(:,:))
    327348    !
    328349    !  Compute surface roughness
    … …  
    343364        rugo(iml,j) = tmp_var(1,j)
    344365      ENDDO
     366c
     367cc   ***   rugo  n'est pas utilise pour l'instant  ******
    345368    !
    346369    !   Build land-sea mask
    … …  
    354377    !
    355378      SUBROUTINE startget_phys1d(varname, iml, jml, lon_in,
    356      .lat_in, nbindex, champ, val_exp)
     379     .lat_in, nbindex, champ, val_exp ,jml2, lon_in2, lat_in2,interbar)
    357380    !
    358381      CHARACTER*(*), INTENT(in) :: varname
    359       INTEGER, INTENT(in) :: iml, jml, nbindex
     382      INTEGER, INTENT(in) :: iml, jml, nbindex, jml2
    360383      REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
     384      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
    361385      REAL, INTENT(inout) :: champ(nbindex)
    362386      REAL, INTENT(in) :: val_exp
     387      LOGICAL interbar
    363388    !
    364389    !
    … …  
    370395            CASE ('tsol')
    371396              IF ( .NOT.ALLOCATED(tsol)) THEN
    372                 CALL start_init_phys( iml, jml, lon_in, lat_in)
     397                CALL start_init_phys( iml, jml, lon_in, lat_in,
     398     .              jml2, lon_in2, lat_in2, interbar )
    373399              ENDIF
    374400              IF ( SIZE(tsol) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
    … …  
    380406            CASE ('qsol')
    381407              IF ( .NOT.ALLOCATED(qsol)) THEN
    382                 CALL start_init_phys( iml, jml, lon_in, lat_in)
     408                CALL start_init_phys( iml, jml, lon_in, lat_in,
     409     .              jml2, lon_in2,lat_in2 , interbar )
    383410              ENDIF
    384411              IF ( SIZE(qsol) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
    … …  
    390417            CASE ('psol')
    391418              IF ( .NOT.ALLOCATED(psol_dyn)) THEN
    392                 CALL start_init_dyn( iml, jml, lon_in, lat_in)
     419                CALL start_init_dyn( iml, jml, lon_in, lat_in,
     420     .              jml2, lon_in2,lat_in2 , interbar )
    393421              ENDIF
    394422              IF (SIZE(psol_dyn) .NE. SIZE(lon_in)*SIZE(lat_in)) THEN
    … …  
    401429          CASE ('zmasq')
    402430              IF (.NOT. ALLOCATED(masque) ) THEN
    403                   CALL start_init_orog ( iml, jml,lon_in, lat_in)
     431                  CALL start_init_orog ( iml, jml,lon_in, lat_in,
     432     .              jml2, lon_in2,lat_in2 , interbar )
    404433              ENDIF
    405434              IF ( SIZE(masque) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
    … …  
    411440            CASE ('zmea')
    412441              IF ( .NOT.ALLOCATED(relief)) THEN
    413                 CALL start_init_orog( iml, jml, lon_in, lat_in)
     442                CALL start_init_orog( iml, jml, lon_in, lat_in,
     443     .            jml2, lon_in2,lat_in2 , interbar )
    414444              ENDIF
    415445              IF ( SIZE(relief) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
    … …  
    421451            CASE ('zstd')
    422452              IF ( .NOT.ALLOCATED(zstd)) THEN
    423                 CALL start_init_orog( iml, jml, lon_in, lat_in)
     453                CALL start_init_orog( iml, jml, lon_in, lat_in,
     454     .              jml2, lon_in2,lat_in2 , interbar )
    424455              ENDIF
    425456              IF ( SIZE(zstd) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
    … …  
    431462            CASE ('zsig')
    432463              IF ( .NOT.ALLOCATED(zsig)) THEN
    433                 CALL start_init_orog( iml, jml, lon_in, lat_in)
     464                CALL start_init_orog( iml, jml, lon_in, lat_in,
     465     .               jml2, lon_in2,lat_in2 , interbar )
    434466              ENDIF
    435467              IF ( SIZE(zsig) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
    … …  
    441473            CASE ('zgam')
    442474              IF ( .NOT.ALLOCATED(zgam)) THEN
    443                 CALL start_init_orog( iml, jml, lon_in, lat_in)
     475                CALL start_init_orog( iml, jml, lon_in, lat_in,
     476     .            jml2, lon_in2,lat_in2 , interbar )
    444477              ENDIF
    445478              IF ( SIZE(zgam) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
    … …  
    451484            CASE ('zthe')
    452485              IF ( .NOT.ALLOCATED(zthe)) THEN
    453                 CALL start_init_orog( iml, jml, lon_in, lat_in)
     486                CALL start_init_orog( iml, jml, lon_in, lat_in,
     487     .            jml2, lon_in2,lat_in2 , interbar )
    454488              ENDIF
    455489              IF ( SIZE(zthe) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
    … …  
    461495            CASE ('zpic')
    462496              IF ( .NOT.ALLOCATED(zpic)) THEN
    463                 CALL start_init_orog( iml, jml, lon_in, lat_in)
     497                CALL start_init_orog( iml, jml, lon_in, lat_in,
     498     .            jml2, lon_in2,lat_in2 , interbar )
    464499              ENDIF
    465500              IF ( SIZE(zpic) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
    … …  
    471506            CASE ('zval')
    472507              IF ( .NOT.ALLOCATED(zval)) THEN
    473                 CALL start_init_orog( iml, jml, lon_in, lat_in)
     508                CALL start_init_orog( iml, jml, lon_in, lat_in,
     509     .            jml2, lon_in2,lat_in2 , interbar )
    474510              ENDIF
    475511              IF ( SIZE(zval) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
    … …  
    479515              ENDIF
    480516              CALL gr_dyn_fi(1, iml, jml, nbindex,zval, champ)
    481              CASE ('rads')
     517            CASE ('rads')
    482518                  champ(:) = 0.0
    483519            CASE ('snow')
    … …  
    510546    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    511547    !
    512       SUBROUTINE start_init_phys( iml, jml, lon_in, lat_in)
    513     !
    514       INTEGER, INTENT(in) :: iml, jml
     548      SUBROUTINE start_init_phys( iml, jml, lon_in, lat_in, jml2,
     549     .                 lon_in2, lat_in2 , interbar )
     550    !
     551      INTEGER, INTENT(in) :: iml, jml ,jml2
    515552      REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
     553      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
     554      LOGICAL interbar
    516555    !
    517556    !  LOCAL
    … …  
    522561      INTEGER :: i, j
    523562    !
     563      CHARACTER*25 title
    524564      CHARACTER*120 :: physfname
    525565      LOGICAL :: check=.TRUE.
    526566    !
    527567      REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
     568      REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:)
    528569      REAL, ALLOCATABLE :: var_ana(:,:), tmp_var(:,:)
    529570    !
    … …  
    549590    !   In case we have a file which is in degrees we do the transformation
    550591    !
     592      DEALLOCATE (lon_rad)
    551593      ALLOCATE(lon_rad(iml_phys))
     594      DEALLOCATE (lon_ini)
     595      ALLOCATE(lon_ini(iml_phys))
     596
    552597      IF ( MAXVAL(lon_phys(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
    553           lon_rad(:) = lon_phys(:,1) * 2.0 * ASIN(1.0) / 180.0
    554       ELSE
    555           lon_rad(:) = lon_phys(:,1)
    556       ENDIF
     598          lon_ini(:) = lon_phys(:,1) * 2.0 * ASIN(1.0) / 180.0
     599      ELSE
     600          lon_ini(:) = lon_phys(:,1)
     601      ENDIF
     602
    557603      ALLOCATE(lat_rad(jml_phys))
     604      ALLOCATE(lat_ini(jml_phys))
     605
    558606      IF ( MAXVAL(lat_phys(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
    559           lat_rad(:) = lat_phys(1,:) * 2.0 * ASIN(1.0) / 180.0
    560       ELSE
    561           lat_rad(:) = lat_phys(1,:)
    562       ENDIF
     607          lat_ini(:) = lat_phys(1,:) * 2.0 * ASIN(1.0) / 180.0
     608      ELSE
     609          lat_ini(:) = lat_phys(1,:)
     610      ENDIF
     611
     612
    563613    !
    564614    !   We get the two standard varibales
    … …  
    569619    !
    570620    !
     621
    571622      CALL flinget(fid_phys, 'ST', iml_phys, jml_phys,
    572623     .llm_tmp, ttm_tmp, 1, 1, var_ana)
    573       CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
    574      . var_ana, iml-1, jml, lon_in, lat_in, tmp_var)
     624
     625      title='ST'
     626      CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini,
     627     . lon_rad, lat_rad, var_ana , interbar  )
     628
     629      IF ( interbar )   THEN
     630        WRITE(6,*) '-------------------------------------------------',
     631     ,'--------------'
     632        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
     633     , ' pour  ST $$$ '
     634        WRITE(6,*) '-------------------------------------------------',
     635     ,'--------------'
     636        CALL inter_barxy ( iml_phys,jml_phys -1,lon_rad,lat_rad ,
     637     ,   var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var   )
     638      ELSE
     639        CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
     640     .    var_ana, iml-1, jml, lon_in, lat_in, tmp_var     )
     641      ENDIF
     642
    575643      CALL gr_int_dyn(tmp_var, tsol, iml-1, jml)
    576644    !
    … …  
    580648      CALL flinget(fid_phys, 'CDSW', iml_phys, jml_phys,
    581649     . llm_tmp, ttm_tmp, 1, 1, var_ana)
    582       CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
    583      . var_ana, iml-1, jml, lon_in, lat_in, tmp_var)
    584       CALL gr_int_dyn(tmp_var, qsol, iml-1, jml)
    585     !
    586       CALL flinclo(fid_phys)
    587     !
     650
     651      title='CDSW'
     652      CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini,
     653     . lon_rad, lat_rad, var_ana, interbar  )
     654
     655      IF ( interbar )   THEN
     656        WRITE(6,*) '-------------------------------------------------',
     657     ,'--------------'
     658        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
     659     , ' pour  CDSW $$$ '
     660        WRITE(6,*) '-------------------------------------------------',
     661     ,'--------------'
     662        CALL inter_barxy ( iml_phys,jml_phys -1,lon_rad,lat_rad ,
     663     ,   var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var  )
     664      ELSE
     665        CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
     666     .    var_ana, iml-1, jml, lon_in, lat_in, tmp_var     )
     667      ENDIF
     668c
     669        CALL gr_int_dyn(tmp_var, qsol, iml-1, jml)
     670    !
     671       CALL flinclo(fid_phys)
     672    !
     673      DEALLOCATE (lon_rad)
     674      DEALLOCATE (lon_ini)
     675      DEALLOCATE (lat_rad)
     676      DEALLOCATE (lat_ini)
    588677      END SUBROUTINE start_init_phys
    589678    !
    … …  
    593682    !
    594683      SUBROUTINE startget_dyn(varname, iml, jml, lon_in, lat_in,
    595      . lml, pls, workvar, champ, val_exp)
     684     . lml, pls, workvar, champ, val_exp,jml2, lon_in2, lat_in2 ,
     685     ,  interbar )
    596686    !
    597687    !   ARGUMENTS
    598688    !
    599689      CHARACTER*(*), INTENT(in) :: varname
    600       INTEGER, INTENT(in) :: iml, jml, lml
     690      INTEGER, INTENT(in) :: iml, jml, lml, jml2
    601691      REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
     692      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
    602693      REAL, INTENT(in) :: pls(iml, jml, lml)
    603694      REAL, INTENT(in) :: workvar(iml, jml, lml)
    604695      REAL, INTENT(inout) :: champ(iml, jml, lml)
    605696      REAL, INTENT(in) :: val_exp
     697      LOGICAL interbar
    606698    !
    607699    !    LOCAL
    … …  
    609701      INTEGER :: il, ij, ii
    610702      REAL :: xppn, xpps
    611     !
    612     !   C'est vraiment une galere de devoir rajouter tant de commons just pour avoir les aires.
    613     !   Il faudrait mettre une structure plus flexible et moins dangereuse.
    614703    !
    615704#include "dimensions.h"
    … …  
    626715          CASE ('u')
    627716            IF ( .NOT.ALLOCATED(psol_dyn)) THEN
    628               CALL start_init_dyn( iml, jml, lon_in, lat_in)
     717              CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 ,
     718     .          lon_in2,lat_in2 , interbar )
    629719            ENDIF
    630720            CALL start_inter_3d('U', iml, jml, lml, lon_in,
    631      .                           lat_in, pls, champ)
     721     .       lat_in, jml2, lon_in2, lat_in2,  pls, champ,interbar )
    632722            DO il=1,lml
    633723              DO ij=1,jml
    … …  
    640730          CASE ('v')
    641731            IF ( .NOT.ALLOCATED(psol_dyn)) THEN
    642               CALL start_init_dyn( iml, jml, lon_in, lat_in)
     732              CALL start_init_dyn( iml, jml, lon_in, lat_in , jml2,
     733     .           lon_in2, lat_in2 , interbar )
    643734            ENDIF
    644             CALL start_inter_3d('V', iml, jml, lml, lon_in,
    645      .                          lat_in, pls, champ)
     735            CALL start_inter_3d('V', iml, jml, lml, lon_in, 
     736     .       lat_in, jml2, lon_in2, lat_in2,  pls, champ, interbar )
    646737            DO il=1,lml
    647738              DO ij=1,jml
    … …  
    654745          CASE ('t')
    655746            IF ( .NOT.ALLOCATED(psol_dyn)) THEN
    656               CALL start_init_dyn( iml, jml, lon_in, lat_in)
     747              CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 ,
     748     .           lon_in2, lat_in2 ,interbar )
    657749            ENDIF
    658750            CALL start_inter_3d('TEMP', iml, jml, lml, lon_in,
    659      .                           lat_in, pls, champ)
     751     .       lat_in, jml2, lon_in2, lat_in2,  pls, champ, interbar )
    660752 
    661753          CASE ('tpot')
    662754            IF ( .NOT.ALLOCATED(psol_dyn)) THEN
    663               CALL start_init_dyn( iml, jml, lon_in, lat_in)
     755              CALL start_init_dyn( iml, jml, lon_in, lat_in , jml2 ,
     756     .            lon_in2, lat_in2 , interbar )
    664757            ENDIF
    665758            CALL start_inter_3d('TEMP', iml, jml, lml, lon_in,
    666      .                           lat_in, pls, champ)
     759     .       lat_in, jml2, lon_in2, lat_in2,  pls, champ, interbar )
    667760            IF ( MINVAL(workvar(:,:,:)) .NE. MAXVAL(workvar(:,:,:)) )
    668761     .                                    THEN
    … …  
    689782          CASE ('q')
    690783            IF ( .NOT.ALLOCATED(psol_dyn)) THEN
    691               CALL start_init_dyn( iml, jml, lon_in, lat_in)
     784              CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 ,
     785     .           lon_in2, lat_in2 , interbar )
    692786            ENDIF
    693787            CALL start_inter_3d('R', iml, jml, lml, lon_in, lat_in,
    694      .                           pls, champ)
     788     .        jml2, lon_in2, lat_in2,  pls, champ, interbar )
    695789            IF ( MINVAL(workvar(:,:,:)) .NE. MAXVAL(workvar(:,:,:)) )
    696790     .                                     THEN
    … …  
    727821    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    728822    !
    729       SUBROUTINE start_init_dyn( iml, jml, lon_in, lat_in)
    730     !
    731       INTEGER, INTENT(in) :: iml, jml
     823      SUBROUTINE start_init_dyn( iml, jml, lon_in, lat_in,jml2,lon_in2 ,
     824     ,             lat_in2 , interbar )
     825    !
     826      INTEGER, INTENT(in) :: iml, jml, jml2
    732827      REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
     828      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
     829      LOGICAL interbar
    733830    !
    734831    !  LOCAL
    … …  
    743840    !
    744841      REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
     842      REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:)
    745843      REAL, ALLOCATABLE :: var_ana(:,:), tmp_var(:,:), z(:,:)
    746844      REAL, ALLOCATABLE :: xppn(:), xpps(:)
    747845      LOGICAL :: allo
    748846    !
    749     !   Ce n'est pas tres pratique d'avoir a charger 3 include pour avoir la grille du modele
    750847    !
    751848#include "dimensions.h"
    752849#include "paramet.h"
    753850#include "comgeom2.h"
     851
     852      CHARACTER*25 title
     853
    754854    !
    755855      physfname = 'ECDYN.nc'
    … …  
    764864      ALLOCATE (lat_dyn(iml_dyn,jml_dyn), stat=iret)
    765865      ALLOCATE (lon_dyn(iml_dyn,jml_dyn), stat=iret)
    766       ALLOCATE (lev_dyn(llm_dyn), stat=iret)
     866      ALLOCATE (levdyn_ini(llm_dyn), stat=iret)
    767867    !
    768868      CALL flinopen(physfname, .FALSE., iml_dyn, jml_dyn, llm_dyn,
    769      . lon_dyn, lat_dyn, lev_dyn, ttm_dyn,
     869     . lon_dyn, lat_dyn, levdyn_ini, ttm_dyn,
    770870     . itau, date, dt, fid_dyn)
    771871    !
    … …  
    781881        DEALLOCATE(lon_rad, stat=iret)
    782882      endif
    783         ALLOCATE(lon_rad(iml_dyn), stat=iret)
     883
     884      ALLOCATE(lon_rad(iml_dyn), stat=iret)
     885      ALLOCATE(lon_ini(iml_dyn))
    784886       
    785887      IF ( MAXVAL(lon_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
    786           lon_rad(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0
    787       ELSE
    788           lon_rad(:) = lon_dyn(:,1)
    789       ENDIF
     888          lon_ini(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0
     889      ELSE
     890          lon_ini(:) = lon_dyn(:,1)
     891      ENDIF
     892
    790893      ALLOCATE(lat_rad(jml_dyn))
     894      ALLOCATE(lat_ini(jml_dyn))
     895
    791896      IF ( MAXVAL(lat_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
    792           lat_rad(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0
    793       ELSE
    794           lat_rad(:) = lat_dyn(1,:)
    795       ENDIF
    796     !
     897          lat_ini(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0
     898      ELSE
     899          lat_ini(:) = lat_dyn(1,:)
     900      ENDIF
     901    !
     902
     903
    797904      ALLOCATE(z(iml, jml))
    798905      ALLOCATE(tmp_var(iml-1,jml))
    … …  
    800907      CALL flinget(fid_dyn, 'Z', iml_dyn, jml_dyn, 0, ttm_dyn,
    801908     .              1, 1, var_ana)
    802       CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
     909c
     910      title='Z'
     911      CALL conf_dat2d( title,iml_dyn, jml_dyn,lon_ini, lat_ini,
     912     . lon_rad, lat_rad, var_ana, interbar  )
     913c
     914      IF ( interbar )   THEN
     915        WRITE(6,*) '-------------------------------------------------',
     916     ,'--------------'
     917        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
     918     , ' pour  Z  $$$ '
     919        WRITE(6,*) '-------------------------------------------------',
     920     ,'--------------'
     921        CALL inter_barxy ( iml_dyn,jml_dyn -1,lon_rad,lat_rad ,
     922     ,    var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var)
     923      ELSE
     924        CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
    803925     .               iml-1, jml, lon_in, lat_in, tmp_var)
     926      ENDIF
     927
    804928      CALL gr_int_dyn(tmp_var, z, iml-1, jml)
    805929    !
    … …  
    808932      CALL flinget(fid_dyn, 'SP', iml_dyn, jml_dyn, 0, ttm_dyn,
    809933     .              1, 1, var_ana)
    810       CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
    811      .               iml-1, jml, lon_in, lat_in, tmp_var)
     934
     935       title='SP'
     936      CALL conf_dat2d( title,iml_dyn, jml_dyn,lon_ini, lat_ini,
     937     . lon_rad, lat_rad, var_ana, interbar  )
     938
     939      IF ( interbar )   THEN
     940        WRITE(6,*) '-------------------------------------------------',
     941     ,'--------------'
     942        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
     943     , ' pour  SP  $$$ '
     944        WRITE(6,*) '-------------------------------------------------',
     945     ,'--------------'
     946        CALL inter_barxy ( iml_dyn,jml_dyn -1,lon_rad,lat_rad ,
     947     ,    var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var)
     948      ELSE
     949        CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
     950     .             iml-1, jml, lon_in, lat_in, tmp_var  )
     951      ENDIF
     952
    812953      CALL gr_int_dyn(tmp_var, psol_dyn, iml-1, jml)
    813954    !
    … …  
    817958    !   coming out of the restart file. In case we dor have it we will initialize it.
    818959    !
    819         CALL start_init_phys( iml, jml, lon_in, lat_in)
     960        CALL start_init_phys( iml, jml, lon_in, lat_in,jml2,lon_in2,
     961     .                 lat_in2 , interbar )
    820962      ELSE
    821963        IF ( SIZE(tsol) .NE. SIZE(psol_dyn) ) THEN
    … …  
    831973            !     coming out of the restart file. In case we dor have it we will initialize it.
    832974            !
    833           CALL start_init_orog( iml, jml, lon_in, lat_in)
     975        CALL start_init_orog( iml, jml, lon_in, lat_in, jml2, lon_in2 ,
     976     .      lat_in2 , interbar )
    834977            !
    835978      ELSE
    … …  
    8771020    !
    8781021      SUBROUTINE start_inter_3d(varname, iml, jml, lml, lon_in,
    879      .                           lat_in, pls_in, var3d)
     1022     .      lat_in, jml2, lon_in2, lat_in2, pls_in, var3d, interbar )
    8801023    !
    8811024    !    This subroutine gets a variables from a 3D file and does the interpolations needed
    … …  
    8851028    !
    8861029      CHARACTER*(*) :: varname
    887       INTEGER :: iml, jml, lml
     1030      INTEGER :: iml, jml, lml, jml2
    8881031      REAL :: lon_in(iml), lat_in(jml), pls_in(iml, jml, lml)
     1032      REAL :: lon_in2(iml) , lat_in2(jml2)
    8891033      REAL :: var3d(iml, jml, lml)
     1034      LOGICAL interbar
     1035      real chmin,chmax
    8901036    !
    8911037    !  LOCAL
    8921038    !
    893       INTEGER :: ii, ij, il
     1039      CHARACTER*25 title
     1040      INTEGER :: ii, ij, il, jsort,i,j,l
    8941041      REAL :: bx, by
    8951042      REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
     1043      REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:) , lev_dyn(:)
    8961044      REAL, ALLOCATABLE :: var_tmp2d(:,:), var_tmp3d(:,:,:)
    8971045      REAL, ALLOCATABLE :: ax(:), ay(:), yder(:)
     1046       REAL, ALLOCATABLE :: varrr(:,:,:)
    8981047      INTEGER, ALLOCATABLE :: lind(:)
    8991048    !
    … …  
    9031052          ALLOCATE(var_ana3d(iml_dyn, jml_dyn, llm_dyn))
    9041053      ENDIF
     1054          ALLOCATE(varrr(iml_dyn, jml_dyn, llm_dyn))
    9051055    !
    9061056    !
    … …  
    9171067    !
    9181068      ALLOCATE(lon_rad(iml_dyn))
     1069      ALLOCATE(lon_ini(iml_dyn))
     1070
    9191071      IF ( MAXVAL(lon_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
    920           lon_rad(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0
    921       ELSE
    922           lon_rad(:) = lon_dyn(:,1)
    923       ENDIF
     1072          lon_ini(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0
     1073      ELSE
     1074          lon_ini(:) = lon_dyn(:,1)
     1075      ENDIF
     1076
    9241077      ALLOCATE(lat_rad(jml_dyn))
     1078      ALLOCATE(lat_ini(jml_dyn))
     1079
     1080      ALLOCATE(lev_dyn(llm_dyn))
     1081
    9251082      IF ( MAXVAL(lat_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
    926           lat_rad(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0
    927       ELSE
    928           lat_rad(:) = lat_dyn(1,:)
    929       ENDIF
    930     !
     1083          lat_ini(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0
     1084      ELSE
     1085          lat_ini(:) = lat_dyn(1,:)
     1086      ENDIF
     1087    !
     1088
     1089      CALL conf_dat3d ( varname,iml_dyn, jml_dyn, llm_dyn, lon_ini,
     1090     . lat_ini, levdyn_ini, lon_rad, lat_rad, lev_dyn, var_ana3d  ,
     1091     ,  interbar                                                   )
     1092
    9311093      ALLOCATE(var_tmp2d(iml-1, jml))
    9321094      ALLOCATE(var_tmp3d(iml, jml, llm_dyn))
    … …  
    9361098      ALLOCATE(lind(llm_dyn))
    9371099    !
     1100 
    9381101      DO il=1,llm_dyn
    9391102        !
    940         CALL grille_m(iml_dyn, jml_dyn, lon_rad, lat_rad,
    941      .var_ana3d(:,:,il), iml-1, jml, lon_in, lat_in, var_tmp2d)
     1103      IF( interbar )  THEN
     1104       IF( il.EQ.1 )  THEN
     1105        WRITE(6,*) '-------------------------------------------------',
     1106     ,'--------------'
     1107        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
     1108     , ' pour ', varname
     1109        WRITE(6,*) '-------------------------------------------------',
     1110     ,'--------------'
     1111       ENDIF
     1112       CALL inter_barxy ( iml_dyn, jml_dyn -1,lon_rad, lat_rad,
     1113     , var_ana3d(:,:,il),iml-1, jml2, lon_in2, lat_in2,jml,var_tmp2d )
     1114      ELSE
     1115       CALL grille_m(iml_dyn, jml_dyn, lon_rad, lat_rad,
     1116     .  var_ana3d(:,:,il), iml-1, jml, lon_in, lat_in, var_tmp2d )
     1117      ENDIF
    9421118        !
    9431119        CALL gr_int_dyn(var_tmp2d, var_tmp3d(:,:,il), iml-1, jml)
    … …  
    9451121       ENDDO
    9461122       !
    947        !  IF needed we return the vertical axis. The spline interpolation
    948        !  Requires the coordinate to be in increasing order.
    949     !
    950       IF ( lev_dyn(1) .LT. lev_dyn(llm_dyn)) THEN
    951           DO il=1,llm_dyn
    952             lind(il) = il
    953           ENDDO       
    954       ELSE
    9551123          DO il=1,llm_dyn
    9561124            lind(il) = llm_dyn-il+1
    9571125          ENDDO
    958       ENDIF
    959     !
     1126    !
     1127c
     1128c  ... Pour l'interpolation verticale ,on interpole du haut de l'atmosphere
     1129c                    vers  le  sol  ...
     1130c
    9601131      DO ij=1,jml
    9611132        DO ii=1,iml-1
    9621133          !
    963           ax(:) = lev_dyn(lind(:)) * 100
     1134          ax(:) = lev_dyn(lind(:))
    9641135          ay(:) = var_tmp3d(ii, ij, lind(:))
    9651136          !
     1137         
    9661138          CALL SPLINE(ax, ay, llm_dyn, 1.e30, 1.e30, yder)
    9671139          !
    … …  
    9761148      ENDDO
    9771149
     1150      do il=1,lml
     1151        call minmax(iml*jml,var3d(1,1,il),chmin,chmax)
     1152      SELECTCASE(varname)
     1153       CASE('U')
     1154          WRITE(*,*) ' U  min max l ',il,chmin,chmax
     1155       CASE('V')
     1156          WRITE(*,*) ' V  min max l ',il,chmin,chmax
     1157       CASE('TEMP')
     1158          WRITE(*,*) ' TEMP  min max l ',il,chmin,chmax
     1159       CASE('R')
     1160          WRITE(*,*) ' R  min max l ',il,chmin,chmax
     1161      END SELECT
     1162           enddo
     1163
    9781164      DEALLOCATE(lon_rad)
    9791165      DEALLOCATE(lat_rad)
Note: See TracChangeset for help on using the changeset viewer.