Changeset 1528 for trunk/LMDZ.MARS/libf


Ignore:
Timestamp:
Apr 2, 2016, 4:09:43 PM (9 years ago)
Author:
emillour
Message:

Mars GCM:

  • Got rid of references to "dimensions.h" from physics packages: use nbp_lon (=iim), nbp_lat (==jjp1) and nbp_lev from module mod_grid_phy_lmdz (in phy_common) instead.
  • Added "ioipsl_getin_p_mod.F90" (getin_p routine) in phy_common to correctly read in parameters from *.def files in a parallel environment.

EM

Location:
trunk/LMDZ.MARS/libf
Files:
3 added
17 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.MARS/libf/aeronomars/inichim_newstart.F90

    r1422 r1528  
    44      use tracer_mod
    55      USE comvert_mod, ONLY: aps,bps
     6      USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev
    67      implicit none
    78
    … …  
    2627!  ----------
    2728!
    28 !  pq(iip1,jjp1,llm,nq)  Advected fields, ie chemical species here
     29!  pq(nbp_lon+1,nbp_lat,nbp_lev,nq)  Advected fields, ie chemical species here
    2930!  qsurf(ngrid,nq)     Amount of tracer on the surface (kg/m2)
    30 !  ps(iip1,jjp1)           Surface pressure (Pa)
     31!  ps(nbp_lon+1,nbp_lat)           Surface pressure (Pa)
    3132!  flagh2o                 flag for initialisation of h2o (1: yes / 0: no)
    3233!  flagthermo              flag for initialisation of thermosphere only (1: yes / 0: no)
    … …  
    3435!=======================================================================
    3536
    36 #include "dimensions.h"
    37 #include "paramet.h"
    38 #include "callkeys.h"
    39 #include "datafile.h"
     37      include "callkeys.h"
     38      include "datafile.h"
    4039
    4140! inputs :
    … …  
    4342      integer,intent(in) :: ngrid         ! number of atmospheric columns in the physics
    4443      integer,intent(in) :: nq                    ! number of tracers
    45       real,intent(in) :: ps(iip1,jjp1)            ! surface pressure in the gcm (Pa)   
     44      real,intent(in) :: ps(nbp_lon+1,nbp_lat)            ! surface pressure in the gcm (Pa)   
    4645      integer,intent(in) :: flagh2o               ! flag for h2o initialisation
    4746      integer,intent(in) :: flagthermo            ! flag for thermosphere initialisation only
    … …  
    4948! outputs :
    5049
    51       real,intent(out) :: pq(iip1,jjp1,llm,nq)  ! advected fields, ie chemical species
     50      real,intent(out) :: pq(nbp_lon+1,nbp_lat,nbp_lev,nq)  ! advected fields, ie chemical species
    5251      real,intent(out) :: qsurf(ngrid,nq)     ! surface values (kg/m2) of tracers
    5352
    … …  
    5655      integer :: iq, i, j, l, n, nbqchem
    5756      integer :: count, ierr, dummy
    58       real    :: mmean(iip1,jjp1,llm)             ! mean molecular mass (g)
     57      real    :: mmean(nbp_lon+1,nbp_lat,nbp_lev)             ! mean molecular mass (g)
    5958      real    :: pgcm                             ! pressure at each layer in the gcm (Pa)
    6059
    … …  
    547546! 3. initialization of tracers
    548547
    549       do i = 1,iip1
    550          do j = 1,jjp1
    551             do l = 1,llm
     548      do i = 1,nbp_lon+1
     549         do j = 1,nbp_lat
     550            do l = 1,nbp_lev
    552551
    553552               pgcm = aps(l) + bps(l)*ps(i,j)  ! gcm pressure
    … …  
    596595      if (igcm_ch4 /= 0) then
    597596         vmr = 10.e-9       
    598          do i = 1,iip1
    599             do j = 1,jjp1
    600                do l = 1,llm
     597         do i = 1,nbp_lon+1
     598            do j = 1,nbp_lat
     599               do l = 1,nbp_lev
    601600                  pq(i,j,l,igcm_ch4) = vmr*mmol(igcm_ch4)/mmean(i,j,l)
    602601               end do
    … …  
    623622         end if
    624623
    625          do i = 1,iip1
    626             do j = 1,jjp1
    627                do l = 1,llm
     624         do i = 1,nbp_lon+1
     625            do j = 1,nbp_lat
     626               do l = 1,nbp_lev
    628627                  ! all ions to 0     
    629628                  pq(i,j,l,igcm_co2plus)  = 0.

  • trunk/LMDZ.MARS/libf/aeronomars/moldiff_red.F90

    r1431 r1528  
    77implicit none
    88
    9 !#include "dimensions.h"
    10 !#include "dimphys.h"
    11 !#include "comcstfi.h"
    12 !#include "callkeys.h"
    13 !#include "comdiurn.h"
    14 !#include "chimiedata.h"
    15 !#include "tracer.h"
    16 !#include "conc.h"
    17 #include "diffusion.h"
     9include "diffusion.h"
    1810
    1911! July 2014 JYC ADD BALISTIC Transport coupling to compute wup for H and H2
    … …  
    937929        use tracer_mod, only: nqmx
    938930        IMPLICIT NONE
    939 !#include "dimensions.h"
    940931
    941932        INTEGER,INTENT(IN) :: nl,nq
    … …  
    973964        use tracer_mod, only: nqmx
    974965        IMPLICIT NONE
    975 !#include "dimensions.h"
    976966
    977967        INTEGER :: nl,nq,l
    … …  
    10581048        use tracer_mod, only: nqmx
    10591049        IMPLICIT NONE
    1060 !#include "dimensions.h"
    10611050       
    10621051        INTEGER :: nl,nq,il,l,i,iq,nlx,iz,ig
    … …  
    14001389        use tracer_mod, only: nqmx
    14011390        IMPLICIT NONE
    1402 !#include "dimensions.h"
    14031391        INTEGER :: nl,nq,nlx,il,nn,iP,ig,compteur
    14041392        INTEGER,DIMENSION(1) :: indP
    … …  
    15021490        use tracer_mod, only: nqmx
    15031491        IMPLICIT NONE
    1504 !#include "dimensions.h"
    15051492        INTEGER :: nl,nq,nlx,il,nn,iP,ig,compteur
    15061493        INTEGER,DIMENSION(1) :: indP

  • trunk/LMDZ.MARS/libf/aeronomars/surfacearea.F

    r1266 r1528  
    1919!==========================================================================
    2020
    21 #include "dimensions.h"
    22 #include "callkeys.h"
    23 #include "chimiedata.h"
     21      include "callkeys.h"
     22      include "chimiedata.h"
    2423
    2524! input

  • trunk/LMDZ.MARS/libf/phymars/albedocaps.F90

    r1381 r1528  
    1212implicit none
    1313
    14 #include"callkeys.h"
     14include"callkeys.h"
    1515
    1616! arguments:
    … …  
    9393                 
    9494implicit none
    95 #include"dimensions.h"
    96 #include"datafile.h"
     95include"datafile.h"
    9796
    9897! arguments:

  • trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F

    r1525 r1528  
    827827c***********************************************************************
    828828
    829 #include "../dyn3d/disvert.F"
    830 #include "../dyn3d/abort_gcm.F"

  • trunk/LMDZ.MARS/libf/phymars/eofdump_mod.F90

    r1524 r1528  
    11module eofdump_mod
    22! this module controls the production of data for EOFs
     3! it won't work if run in parallel (but it's OK, we don't use it anymore...)
     4! Mainly kept for reference.
    35implicit none
    46! Dump profiles for EOFs every ieofs physics timesteps,
    … …  
    1517      subroutine eofdump(ngrid,nlayer,u,v,t,rho,ps)
    1618
     19      use mod_grid_phy_lmdz, only: nbp_lon, nbp_lat
    1720      implicit none
    1821!
    … …  
    2124!     Corrected small bug in sampling rate/count, EM 11/2007
    2225!
    23 #include "dimensions.h"
    2426!
    2527
    … …  
    5254      if (mod(count+1,ieofs).eq.0) then
    5355!        write(*,*)'eofdump: dump --> ps(1)=',ps(1)
    54         do i=1,iim,eofskip
    55           do j=1+eofskip/2,jjm+1,eofskip
    56             ig = 1+ (j-2)*iim +i
     56        do i=1,nbp_lon,eofskip
     57          do j=1+eofskip/2,nbp_lat,eofskip
     58            ig = 1+ (j-2)*nbp_lon +i
    5759#ifdef NC_DOUBLE
    5860            write(uedata) (real(u(ig,l)),l=1,nlayer)
    … …  
    8284      use time_phylmdz_mod, only: daysec, dtphys
    8385      USE comvert_mod, ONLY: aps,bps
     86      use mod_grid_phy_lmdz, only: nbp_lon, nbp_lat
    8487      implicit none
    8588!
    8689!     Initialise dumping of profiles for EOF calculations
    8790!
    88 #include "dimensions.h"
    8991
    9092      integer,intent(in) :: ngrid ! total number of physics grid points
    … …  
    9698
    9799      if (firstcall) then
    98          npgrid=ngrid+2*(iim-1)
     100         npgrid=ngrid+2*(nbp_lon-1)
    99101         firstcall=.false.
    100102      endif
    … …  
    111113      open(uehead,file='profiles.hdr',form='formatted')
    112114      write(uehead,*) 0.E+0,0,0,ieofs,1,0
    113       write(uehead,*) iim,npgrid/iim,npgrid,nlayer
     115      write(uehead,*) nbp_lon,npgrid/nbp_lon,npgrid,nlayer
    114116
    115       do i=1,iim,eofskip
    116         do j=1+eofskip/2,jjm+1,eofskip   
    117           ig = 1+ (j-2)*iim +i
     117      do i=1,nbp_lon,eofskip
     118        do j=1+eofskip/2,nbp_lat,eofskip   
     119          ig = 1+ (j-2)*nbp_lon +i
    118120          if(j.eq.1) stop 'Problem in ineofdump.F'
    119           if(j.eq.jjm+1) stop 'Problem in ineofdump.F'
     121          if(j.eq.nbp_lat) stop 'Problem in ineofdump.F'
    120122#ifdef NC_DOUBLE
    121123          write(uehead,*) real(long(ig)*180./pi),real(lati(ig)*180./pi)

  • trunk/LMDZ.MARS/libf/phymars/getslopes.F90

    r1266 r1528  
    33use comgeomfi_h, only: long, lati
    44use slope_mod, only: theta_sl, psi_sl
    5 USE comcstfi_h
     5use comcstfi_h, only: g, rad, pi
     6use mod_phys_lmdz_para, only: is_parallel
     7use mod_grid_phy_lmdz, only: nbp_lon, nbp_lat
    68implicit none
    79
    8 #include "dimensions.h"
    910
    1011! This routine computes slope inclination and orientation for the GCM (callslope=.true. in callphys.def)
    … …  
    1617integer,intent(in) :: ngrid ! nnumber of atmospheric columns
    1718real,intent(in) :: geopot(ngrid)     ! geopotential on phy grid
    18 real topogrid(iim,jjm+1) ! topography on lat/lon grid with poles and only one -180/180 point
    19 real latigrid(iim,jjm+1),longgrid(iim,jjm+1) ! meshgrid of latitude and longitude values (radians)
     19real topogrid(nbp_lon,nbp_lat) ! topography on lat/lon grid with poles and only one -180/180 point
     20real latigrid(nbp_lon,nbp_lat),longgrid(nbp_lon,nbp_lat) ! meshgrid of latitude and longitude values (radians)
    2021real theta_val ! slope inclination
    2122real psi_val   ! slope orientation
    22 real gradx(iim,jjm+1) ! x: latitude-wise topography gradient,  increasing northward
    23 real grady(iim,jjm+1) ! y: longitude-wise topography gradient, increasing westward
     23real gradx(nbp_lon,nbp_lat) ! x: latitude-wise topography gradient,  increasing northward
     24real grady(nbp_lon,nbp_lat) ! y: longitude-wise topography gradient, increasing westward
    2425integer i,j,ig0
    2526integer id2,idm1 ! a trick to compile testphys1d with debug option
    2627
     28if (is_parallel) then
     29  ! This routine only works in serial mode so stop now.
     30  write(*,*) "getslopes Error: this routine is not designed to run in parallel"
     31  stop
     32endif
     33
    2734id2  = 2
    28 idm1 = iim-1
     35idm1 = nbp_lon-1
    2936
    3037! rearrange topography on a 2d array
    31 do j=2,jjm
    32    ig0= 1+(j-2)*iim
    33    do i=1,iim
     38do j=2,nbp_lat-1
     39   ig0= 1+(j-2)*nbp_lon
     40   do i=1,nbp_lon
    3441      topogrid(i,j)=geopot(ig0+i)/g
    3542      latigrid(i,j)=lati(ig0+i)
    … …  
    4148latigrid(:,1) = lati(1)
    4249longgrid(:,1) = long(1)
    43 topogrid(:,jjm+1) = geopot(ngrid)/g
    44 latigrid(:,jjm+1) = lati(ngrid)
    45 longgrid(:,jjm+1) = long(ngrid)
     50topogrid(:,nbp_lat) = geopot(ngrid)/g
     51latigrid(:,nbp_lat) = lati(ngrid)
     52longgrid(:,nbp_lat) = long(ngrid)
    4653
    4754
    … …  
    4956! compute topography gradient
    5057! topogrid and rad are both in meters
    51 do j=2,jjm
    52    do i=1,iim
     58do j=2,nbp_lat-1
     59   do i=1,nbp_lon
    5360     gradx(i,j) = (topogrid(i,j+1) - topogrid(i,j-1)) / (latigrid(i,j+1)-latigrid(i,j-1))
    5461     gradx(i,j) = gradx(i,j) / rad
    5562   enddo
    56    grady(1,j) = (topogrid(id2,j) - topogrid(iim,j)) / (2*pi+longgrid(id2,j)-longgrid(iim,j))
     63   grady(1,j) = (topogrid(id2,j) - topogrid(nbp_lon,j)) / (2*pi+longgrid(id2,j)-longgrid(nbp_lon,j))
    5764   grady(1,j) = grady(1,j) / rad
    58    grady(iim,j) = (topogrid(1,j) - topogrid(idm1,j)) / (2*pi+longgrid(1,j)-longgrid(idm1,j))
    59    grady(iim,j) = grady(iim,j) / rad
    60    do i=2,iim-1
     65   grady(nbp_lon,j) = (topogrid(1,j) - topogrid(idm1,j)) / (2*pi+longgrid(1,j)-longgrid(idm1,j))
     66   grady(nbp_lon,j) = grady(nbp_lon,j) / rad
     67   do i=2,nbp_lon-1
    6168     grady(i,j) = (topogrid(i+1,j) - topogrid(i-1,j)) / (longgrid(i+1,j)-longgrid(i-1,j))
    6269     grady(i,j) = grady(i,j) / rad
    … …  
    6673gradx(:,1) = 0.
    6774grady(:,1) = 0.
    68 gradx(:,jjm+1) = 0.
    69 grady(:,jjm+1) = 0.
     75gradx(:,nbp_lat) = 0.
     76grady(:,nbp_lat) = 0.
    7077
    7178
    … …  
    7481theta_sl(:) = 0.
    7582psi_sl(:)   = 0.
    76 do j=2,jjm
    77    do i=1,iim
     83do j=2,nbp_lat-1
     84   do i=1,nbp_lon
    7885   
    79      ig0= 1+(j-2)*iim
     86     ig0= 1+(j-2)*nbp_lon
    8087   
    8188     theta_val=atan(sqrt( (gradx(i,j))**2 + (grady(i,j))**2 ))

  • trunk/LMDZ.MARS/libf/phymars/inistats.F

    r1524 r1528  
    55      USE comcstfi_h, ONLY: pi
    66      USE time_phylmdz_mod, ONLY: daysec,dtphys
     7      USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
     8      USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev
    79      implicit none
    810
    9       include "dimensions.h"
    10       include "paramet.h"
    11       include "comgeom.h"
    1211      include "statto.h"
    1312      include "netcdf.inc"
    … …  
    1615      integer :: nid
    1716      integer :: l,nsteppd
    18       real, dimension(llm) ::  sig_s
     17      real, dimension(nbp_lev) ::  sig_s
     18      real :: lon_reg_ext(nbp_lon+1) ! extended longitudes
    1919      integer :: idim_lat,idim_lon,idim_llm,idim_llmp1,idim_time
    2020      real, dimension(istime) :: lt
    … …  
    4040      write (*,*)
    4141
    42       do l= 1, llm
     42      do l= 1, nbp_lev
    4343         sig_s(l)=((ap(l)+ap(l+1))/preff+bp(l)+bp(l+1))/2.
    4444         pseudoalt(l)=-10.*log(presnivs(l)/preff)   
    4545      enddo
     46     
     47      lon_reg_ext(1:nbp_lon)=lon_reg(1:nbp_lon)
     48      !add extra redundant point (180 degrees, since lon_reg starts at -180
     49      lon_reg_ext(nbp_lon+1)=-lon_reg_ext(1)
    4650
    4751      if (is_master) then
    … …  
    5458      endif
    5559
    56       ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_lat)
    57       ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_lon)
    58       ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
    59       ierr = NF_DEF_DIM (nid, "llmp1", llm+1, idim_llmp1)
     60      ierr = NF_DEF_DIM (nid, "latitude", nbp_lat, idim_lat)
     61      ierr = NF_DEF_DIM (nid, "longitude", nbp_lon+1, idim_lon)
     62      ierr = NF_DEF_DIM (nid, "altitude", nbp_lev, idim_llm)
     63      ierr = NF_DEF_DIM (nid, "llmp1", nbp_lev+1, idim_llmp1)
    6064      ierr = NF_DEF_DIM (nid, "Time", NF_UNLIMITED, idim_time)
    6165
    … …  
    6973     &            "degrees_north",1,idim_lat,nvarid,ierr)
    7074#ifdef NC_DOUBLE
    71       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
     75      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,lat_reg/pi*180)
    7276#else
    73       ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
     77      ierr = NF_PUT_VAR_REAL (nid,nvarid,lat_reg/pi*180)
    7478#endif
    7579      call def_var_stats(nid,"longitude","East longitude",
    7680     &            "degrees_east",1,idim_lon,nvarid,ierr)
    7781#ifdef NC_DOUBLE
    78       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
     82      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,lon_reg_ext/pi*180)
    7983#else
    80       ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
     84      ierr = NF_PUT_VAR_REAL (nid,nvarid,lon_reg_ext/pi*180)
    8185#endif
    8286

  • trunk/LMDZ.MARS/libf/phymars/iniwrite.F

    r1524 r1528  
    1       SUBROUTINE iniwrite(nid,idayref,phis)
     1      SUBROUTINE iniwrite(nid,idayref,phis,area)
    22
    33      use comsoil_h, only: mlayer, nsoilmx
    … …  
    88      USE time_phylmdz_mod, ONLY: hour_ini, daysec, dtphys
    99      USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
     10      USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
     11      USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev
    1012      IMPLICIT NONE
    1113
    … …  
    2628c   -------------
    2729
    28 #include "dimensions.h"
    29 #include "paramet.h"
    30 #include "comgeom.h"
    31 #include "netcdf.inc"
     30      include "netcdf.inc"
    3231
    3332c   Arguments:
    … …  
    3635      integer,intent(in) :: nid        ! NetCDF file ID
    3736      INTEGER*4,intent(in) :: idayref  ! date (initial date for this run)
    38       real,intent(in) :: phis(ip1jmp1) ! surface geopotential
     37      real,intent(in) :: phis(nbp_lon+1,nbp_lat) ! surface geopotential
     38      real,intent(in) :: area(nbp_lon+1,nbp_lat) ! mesh area (m2)
    3939
    4040c   Local:
    … …  
    4444      REAL tab_cntrl(length) ! run parameters are stored in this array
    4545      INTEGER ierr
    46 
    47       integer :: nvarid,idim_index,idim_rlonu,idim_rlonv
    48       integer :: idim_rlatu,idim_rlatv,idim_llmp1,idim_llm
     46      REAl :: lon_reg_ext(nbp_lon+1) ! extended longitudes
     47
     48      integer :: nvarid,idim_index,idim_rlonv
     49      integer :: idim_rlatu,idim_llmp1,idim_llm
    4950      integer :: idim_nsoilmx ! "subsurface_layers" dimension ID #
    5051      integer, dimension(2) :: id 
    … …  
    5455         tab_cntrl(l)=0.
    5556      ENDDO
    56       tab_cntrl(1)  = real(iim)
    57       tab_cntrl(2)  = real(jjm)
    58       tab_cntrl(3)  = real(llm)
     57      tab_cntrl(1)  = real(nbp_lon)
     58      tab_cntrl(2)  = real(nbp_lat-1)
     59      tab_cntrl(3)  = real(nbp_lev)
    5960      tab_cntrl(4)  = real(idayref)
    6061      tab_cntrl(5)  = rad
    … …  
    101102
    102103      ierr = NF_DEF_DIM (nid, "index", length, idim_index)
    103       ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
    104       ierr = NF_DEF_DIM (nid, "latitude", jjp1, idim_rlatu)
    105       ierr = NF_DEF_DIM (nid, "longitude", iip1, idim_rlonv)
    106       ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
    107       ierr = NF_DEF_DIM (nid, "interlayer", (llm+1), idim_llmp1)
    108       ierr = NF_DEF_DIM (nid, "altitude", llm, idim_llm)
     104!      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
     105      ierr = NF_DEF_DIM (nid, "latitude", nbp_lat, idim_rlatu)
     106      ierr = NF_DEF_DIM (nid, "longitude", nbp_lon+1, idim_rlonv)
     107!      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
     108      ierr = NF_DEF_DIM (nid, "interlayer", (nbp_lev+1), idim_llmp1)
     109      ierr = NF_DEF_DIM (nid, "altitude", nbp_lev, idim_llm)
    109110      ierr = NF_DEF_DIM (nid,"subsurface_layers",nsoilmx,idim_nsoilmx)
    110111c
    … …  
    131132c --------------------------
    132133c  longitudes and latitudes
    133       ierr = NF_REDEF (nid)
    134 #ifdef NC_DOUBLE
    135       ierr = NF_DEF_VAR (nid, "rlonu", NF_DOUBLE, 1, idim_rlonu,nvarid)
    136 #else
    137       ierr = NF_DEF_VAR (nid, "rlonu", NF_FLOAT, 1, idim_rlonu,nvarid)
    138 #endif
    139       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 21,
    140      .                       "Longitudes at u nodes")
    141       ierr = NF_ENDDEF(nid)
    142 #ifdef NC_DOUBLE
    143       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu/pi*180)
    144 #else
    145       ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu/pi*180)
    146 #endif
     134!
     135!      ierr = NF_REDEF (nid)
     136!#ifdef NC_DOUBLE
     137!      ierr = NF_DEF_VAR (nid, "rlonu", NF_DOUBLE, 1, idim_rlonu,nvarid)
     138!#else
     139!      ierr = NF_DEF_VAR (nid, "rlonu", NF_FLOAT, 1, idim_rlonu,nvarid)
     140!#endif
     141!      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 21,
     142!     .                       "Longitudes at u nodes")
     143!      ierr = NF_ENDDEF(nid)
     144!#ifdef NC_DOUBLE
     145!      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu/pi*180)
     146!#else
     147!      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu/pi*180)
     148!#endif
    147149c
    148150c --------------------------
    … …  
    158160      ierr = NF_ENDDEF(nid)
    159161#ifdef NC_DOUBLE
    160       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu/pi*180)
    161 #else
    162       ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu/pi*180)
    163 #endif
    164 c
    165 c --------------------------
     162      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,lat_reg/pi*180)
     163#else
     164      ierr = NF_PUT_VAR_REAL (nid,nvarid,lat_reg/pi*180)
     165#endif
     166c
     167c --------------------------
     168      lon_reg_ext(1:nbp_lon)=lon_reg(1:nbp_lon)
     169      !add extra redundant point (180 degrees, since lon_reg starts at -180
     170      lon_reg_ext(nbp_lon+1)=-lon_reg_ext(1)
     171
    166172      ierr = NF_REDEF (nid)
    167173#ifdef NC_DOUBLE
    … …  
    175181      ierr = NF_ENDDEF(nid)
    176182#ifdef NC_DOUBLE
    177       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv/pi*180)
    178 #else
    179       ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv/pi*180)
     183      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,lon_reg_ext/pi*180)
     184#else
     185      ierr = NF_PUT_VAR_REAL (nid,nvarid,lon_reg_ext/pi*180)
    180186#endif
    181187c
    … …  
    201207c
    202208c --------------------------
    203       ierr = NF_REDEF (nid)
    204 #ifdef NC_DOUBLE
    205       ierr = NF_DEF_VAR (nid, "rlatv", NF_DOUBLE, 1, idim_rlatv,nvarid)
    206 #else
    207       ierr = NF_DEF_VAR (nid, "rlatv", NF_FLOAT, 1, idim_rlatv,nvarid)
    208 #endif
    209       ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
    210      .                       "Latitudes at v nodes")
    211       ierr = NF_ENDDEF(nid)
    212 #ifdef NC_DOUBLE
    213       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv/pi*180)
    214 #else
    215       ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv/pi*180)
    216 #endif
     209!      ierr = NF_REDEF (nid)
     210!#ifdef NC_DOUBLE
     211!      ierr = NF_DEF_VAR (nid, "rlatv", NF_DOUBLE, 1, idim_rlatv,nvarid)
     212!#else
     213!      ierr = NF_DEF_VAR (nid, "rlatv", NF_FLOAT, 1, idim_rlatv,nvarid)
     214!#endif
     215!      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 20,
     216!     .                       "Latitudes at v nodes")
     217!      ierr = NF_ENDDEF(nid)
     218!#ifdef NC_DOUBLE
     219!      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv/pi*180)
     220!#else
     221!      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv/pi*180)
     222!#endif
    217223c
    218224c --------------------------
    … …  
    276282c  Mesh area and conversion coefficients cov. <-> contra. <--> natural
    277283
    278       id(1)=idim_rlonu
    279       id(2)=idim_rlatu
    280 c
    281       ierr = NF_REDEF (nid)
    282 #ifdef NC_DOUBLE
    283       ierr = NF_DEF_VAR (nid, "cu", NF_DOUBLE, 2, id,nvarid)
    284 #else
    285       ierr = NF_DEF_VAR (nid, "cu", NF_FLOAT, 2, id,nvarid)
    286 #endif
    287       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 40,
    288      .             "Conversion coefficients cov <--> natural")
    289       ierr = NF_ENDDEF(nid)
    290 #ifdef NC_DOUBLE
    291       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
    292 #else
    293       ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
    294 #endif
    295 c
    296       id(1)=idim_rlonv
    297       id(2)=idim_rlatv
    298 c
    299 c --------------------------
    300       ierr = NF_REDEF (nid)
    301 #ifdef NC_DOUBLE
    302       ierr = NF_DEF_VAR (nid, "cv", NF_DOUBLE, 2, id,nvarid)
    303 #else
    304       ierr = NF_DEF_VAR (nid, "cv", NF_FLOAT, 2, id,nvarid)
    305 #endif
    306       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 40,
    307      .             "Conversion coefficients cov <--> natural")
    308       ierr = NF_ENDDEF(nid)
    309 #ifdef NC_DOUBLE
    310       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
    311 #else
    312       ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
    313 #endif
     284!      id(1)=idim_rlonu
     285!      id(2)=idim_rlatu
     286c
     287!      ierr = NF_REDEF (nid)
     288!#ifdef NC_DOUBLE
     289!      ierr = NF_DEF_VAR (nid, "cu", NF_DOUBLE, 2, id,nvarid)
     290!#else
     291!      ierr = NF_DEF_VAR (nid, "cu", NF_FLOAT, 2, id,nvarid)
     292!#endif
     293!      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 40,
     294!     .             "Conversion coefficients cov <--> natural")
     295!      ierr = NF_ENDDEF(nid)
     296!#ifdef NC_DOUBLE
     297!      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
     298!#else
     299!      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
     300!#endif
     301c
     302!      id(1)=idim_rlonv
     303!      id(2)=idim_rlatv
     304c
     305c --------------------------
     306!      ierr = NF_REDEF (nid)
     307!#ifdef NC_DOUBLE
     308!      ierr = NF_DEF_VAR (nid, "cv", NF_DOUBLE, 2, id,nvarid)
     309!#else
     310!      ierr = NF_DEF_VAR (nid, "cv", NF_FLOAT, 2, id,nvarid)
     311!#endif
     312!      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 40,
     313!     .             "Conversion coefficients cov <--> natural")
     314!      ierr = NF_ENDDEF(nid)
     315!#ifdef NC_DOUBLE
     316!      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
     317!#else
     318!      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
     319!#endif
    314320c
    315321      id(1)=idim_rlonv
    … …  
    327333      ierr = NF_ENDDEF(nid)
    328334#ifdef NC_DOUBLE
    329       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
    330 #else
    331       ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
     335      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,area)
     336#else
     337      ierr = NF_PUT_VAR_REAL (nid,nvarid,area)
    332338#endif
    333339c
    … …  
    352358c
    353359
    354       write(*,*)'iniwrite: iim,jjm,llm,idayref',iim,jjm,llm,idayref
     360      write(*,*)'iniwrite: nbp_lon,nbp_lat,nbp_lev,idayref',
     361     & nbp_lon,nbp_lat,nbp_lev,idayref
    355362      write(*,*)'iniwrite: rad,omeg,g,mugaz,rcp',
    356      s rad,omeg,g,mugaz,rcp
     363     & rad,omeg,g,mugaz,rcp
    357364      write(*,*)'iniwrite: daysec,dtphys',daysec,dtphys
    358365

  • trunk/LMDZ.MARS/libf/phymars/iniwritesoil.F90

    r1266 r1528  
    1 subroutine iniwritesoil(nid,ngrid)
     1subroutine iniwritesoil(nid,ngrid,inertia,area)
    22
    33! initialization routine for 'writediagoil'. Here we create/define
    … …  
    55! (time-independent) parameters.
    66
    7 use comsoil_h, only: mlayer, inertiedat, nsoilmx
    8 USE comcstfi_h
     7use comsoil_h, only: mlayer, nsoilmx
     8USE comcstfi_h, only: pi
     9USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
     10use mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
    911
    1012implicit none
    1113
    12 #include"dimensions.h"
    13 #include"paramet.h"
    14 #include"comgeom.h"
    15 #include"netcdf.inc"
     14include"netcdf.inc"
    1615
    1716! Arguments:
    1817integer,intent(in) :: ngrid
    1918integer,intent(in) :: nid ! NetCDF output file ID
     19real,intent(in) :: inertia(nbp_lon+1,nbp_lat,nsoilmx)
     20real,intent(in) :: area(nbp_lon+1,nbp_lat) ! mesh area (m2)
    2021
    2122! Local variables:
    … …  
    3031integer,dimension(3) :: dimids ! to store IDs of dimensions of a variable
    3132character(len=60) :: text ! to store some text
    32 real,dimension(iip1,jjp1,nsoilmx) :: data3 ! to store 3D data
     33real,dimension(nbp_lon+1,nbp_lat,nsoilmx) :: data3 ! to store 3D data
    3334integer :: i,j,l,ig0
     35real :: lon_reg_ext(nbp_lon+1) ! extended longitudes
    3436
    3537! 1. Define the dimensions
    … …  
    3840
    3941! Define the dimensions
    40 ierr=NF_DEF_DIM(nid,"longitude",iip1,idim_rlonv)
    41 ! iip1 known from paramet.h
     42ierr=NF_DEF_DIM(nid,"longitude",nbp_lon+1,idim_rlonv)
    4243if (ierr.ne.NF_NOERR) then
    4344  write(*,*)"iniwritesoil: Error, could not define longitude dimension"
    4445endif
    45 ierr=NF_DEF_DIM(nid,"latitude",jjp1,idim_rlatu)
    46 ! jjp1 known from paramet.h
     46ierr=NF_DEF_DIM(nid,"latitude",nbp_lat,idim_rlatu)
    4747if (ierr.ne.NF_NOERR) then
    4848  write(*,*)"iniwritesoil: Error, could not define latitude dimension"
    … …  
    8181ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
    8282
     83lon_reg_ext(1:nbp_lon)=lon_reg(1:nbp_lon)
     84!add extra redundant point (180 degrees, since lon_reg starts at -180
     85lon_reg_ext(nbp_lon+1)=-lon_reg_ext(1)
     86
    8387! Write longitude to file
    8488ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
    8589! Write
    8690#ifdef NC_DOUBLE
    87 ierr=NF_PUT_VAR_DOUBLE(nid,varid,rlonv*(180./pi))
    88 #else
    89 ierr=NF_PUT_VAR_REAL(nid,varid,rlonv*(180./pi))
     91ierr=NF_PUT_VAR_DOUBLE(nid,varid,lon_reg_ext*(180./pi))
     92#else
     93ierr=NF_PUT_VAR_REAL(nid,varid,lon_reg_ext*(180./pi))
    9094#endif
    9195! Note: rlonv is known from comgeom.h and pi from comcstfi.h
    … …  
    117121! Write
    118122#ifdef NC_DOUBLE
    119 ierr=NF_PUT_VAR_DOUBLE(nid,varid,rlatu*(180./pi))
    120 #else
    121 ierr=NF_PUT_VAR_REAL(nid,varid,rlatu*(180./pi))
    122 #endif
    123 ! Note: rlatu is known from comgeom.h and pi from comcstfi.h
     123ierr=NF_PUT_VAR_DOUBLE(nid,varid,lat_reg*(180./pi))
     124#else
     125ierr=NF_PUT_VAR_REAL(nid,varid,lat_reg*(180./pi))
     126#endif
    124127if (ierr.ne.NF_NOERR) then
    125128  write(*,*)"iniwritesoil: Error, could not write longitude variable"
    … …  
    209212! Write
    210213#ifdef NC_DOUBLE
    211 ierr=NF_PUT_VAR_DOUBLE(nid,varid,aire)
    212 #else
    213 ierr=NF_PUT_VAR_REAL(nid,varid,aire)
    214 #endif
    215 ! Note: aire is known from comgeom.h
     214ierr=NF_PUT_VAR_DOUBLE(nid,varid,area)
     215#else
     216ierr=NF_PUT_VAR_REAL(nid,varid,area)
     217#endif
    216218if (ierr.ne.NF_NOERR) then
    217219  write(*,*)"iniwritesoil: Error, could not write area variable"
    … …  
    240242ierr=NF_PUT_ATT_TEXT(nid,varid,"units",len_trim(text),text)
    241243
    242 ! Recast data along 'dynamics' grid
    243 ! Note: inertiedat is known from comsoil_h
    244 
    245 do l=1,nsoilmx
    246   ! handle the poles
    247   do i=1,iip1
    248     data3(i,1,l)=inertiedat(1,l)
    249     data3(i,jjp1,l)=inertiedat(ngrid,l)
    250   enddo
    251   ! rest of the grid
    252   do j=2,jjm
    253     ig0=1+(j-2)*iim
    254     do i=1,iim
    255       data3(i,j,l)=inertiedat(ig0+i,l)
    256     enddo
    257     data3(iip1,j,l)=data3(1,j,l) ! extra (modulo) longitude
    258   enddo
    259 enddo ! of do l=1,nsoilmx
    260 
    261244! Write data2 to file
    262245ierr=NF_ENDDEF(nid) ! switch out of NetCDF define mode
    263246! Write
    264247#ifdef NC_DOUBLE
    265 ierr=NF_PUT_VAR_DOUBLE(nid,varid,data3)
    266 #else
    267 ierr=NF_PUT_VAR_REAL(nid,varid,data3)
     248ierr=NF_PUT_VAR_DOUBLE(nid,varid,inertia)
     249#else
     250ierr=NF_PUT_VAR_REAL(nid,varid,inertia)
    268251#endif
    269252if (ierr.ne.NF_NOERR) then

  • trunk/LMDZ.MARS/libf/phymars/mkstat.F90

    r1130 r1528  
    1111
    1212use mod_phys_lmdz_para, only : is_master
     13use mod_grid_phy_lmdz, only : nbp_lon, nbp_lat, nbp_lev
    1314
    1415implicit none
    1516
    16 #include "dimensions.h"
    17 #include "statto.h"
    18 #include "netcdf.inc"
     17include "statto.h"
     18include "netcdf.inc"
    1919
    20 integer,parameter :: iip1=iim+1
    21 integer,parameter :: jjp1=jjm+1
    2220integer :: ierr,nid,nbvar,i,ndims,lt,nvarid
    2321integer, dimension(4) :: id,varid,start,size
    2422integer, dimension(5) :: dimids
    2523character (len=50) :: name,nameout,units,title
    26 real, dimension(iip1,jjp1,llm) :: sum3d,square3d,mean3d,sd3d
    27 real, dimension(iip1,jjp1) :: sum2d,square2d,mean2d,sd2d
     24real, dimension(nbp_lon+1,nbp_lat,nbp_lev) :: sum3d,square3d,mean3d,sd3d
     25real, dimension(nbp_lon+1,nbp_lat) :: sum2d,square2d,mean2d,sd2d
    2826real, dimension(istime) :: time
    29 real, dimension(jjp1) :: lat
    30 real, dimension(iip1) :: lon
    31 real, dimension(llm) :: alt
     27real, dimension(nbp_lat) :: lat
     28real, dimension(nbp_lon+1) :: lon
     29real, dimension(nbp_lev) :: alt
    3230logical :: lcopy=.true.
    3331!integer :: latid,lonid,altid,timeid
    … …  
    107105!      dimout(4)=timeid
    108106
    109       size=(/iip1,jjp1,llm,1/)
     107      size=(/nbp_lon+1,nbp_lat,nbp_lev,1/)
    110108      do lt=1,istime
    111109         start=(/1,1,1,lt/)
    … …  
    137135!      dimout(3)=timeid
    138136
    139       size=(/iip1,jjp1,1,0/)
     137      size=(/nbp_lon+1,nbp_lat,1,0/)
    140138      do lt=1,istime
    141139         start=(/1,1,lt,0/)

  • trunk/LMDZ.MARS/libf/phymars/newcondens.F

    r1438 r1528  
    6161c    ------------------
    6262c
    63 #include "dimensions.h"
    64 #include "callkeys.h"
     63      include "callkeys.h"
    6564
    6665c-----------------------------------------------------------------------

  • trunk/LMDZ.MARS/libf/phymars/physiq.F

    r1525 r1528  
    148148c    ------------------
    149149
    150 #include "dimensions.h"
    151150#include "callkeys.h"
    152151#include "comg1d.h"

  • trunk/LMDZ.MARS/libf/phymars/surfini.F

    r1381 r1528  
    1313#endif
    1414      USE comcstfi_h
     15      use mod_grid_phy_lmdz, only: nbp_lon, nbp_lat
    1516      IMPLICIT NONE
    1617c=======================================================================
    … …  
    2223c   Declarations:
    2324c   -------------
    24 #include "dimensions.h"
    2525#include "callkeys.h"
    2626#include "datafile.h"
    … …  
    5555      INTEGER nb_ice(klon_glo,2)   ! number of counts | detected ice for GCM grid
    5656#endif
    57       INTEGER latice(jjm,2),lonice (iim,2) ! number of counts | detected ice along lat & lon axis
     57      INTEGER latice(nbp_lat-1,2),lonice (nbp_lon,2) ! number of counts | detected ice along lat & lon axis
    5858
    5959      REAL step,count,ratiolat
    … …  
    228228             zelon = i - 180.
    229229             zelat = 90. - j
    230             if ((abs(lati_glo(ig)*180./pi-zelat).le.90./real(jjm)) .and.
    231      &        (abs(long_glo(ig)*180./pi-zelon).le.180./real(iim))) then
     230            if ((abs(lati_glo(ig)*180./pi-zelat).le.
     231     &           90./real(nbp_lat-1)) .and.
     232     &          (abs(long_glo(ig)*180./pi-zelon).le.
     233     &           180./real(nbp_lon))) then
    232234              ! count all points in that GCM grid point
    233235              nb_ice(ig,1) = nb_ice(ig,1) + 1
    … …  
    240242
    241243        ! projection of nb_ice on GCM lat and lon axes
    242           latice(1+(ig-2)/iim,:) =
    243      &     latice(1+(ig-2)/iim,:) + nb_ice(ig,:)
    244           lonice(1+mod(ig-2,iim),:) =
    245      &     lonice(1+mod(ig-2,iim),:) + nb_ice(ig,:) ! lonice is USELESS ...
     244          latice(1+(ig-2)/nbp_lon,:) =
     245     &     latice(1+(ig-2)/nbp_lon,:) + nb_ice(ig,:)
     246          lonice(1+mod(ig-2,nbp_lon),:) =
     247     &     lonice(1+mod(ig-2,nbp_lon),:) + nb_ice(ig,:) ! lonice is USELESS ...
    246248
    247249         enddo ! of do ig=2,klon_glo-1
    … …  
    253255         latice(1,:)   = nb_ice(1,:)
    254256         lonice(1,:)   = nb_ice(1,:)
    255          latice(jjm,:) = nb_ice(ngrid,:)
    256          lonice(iim,:) = nb_ice(ngrid,:)
     257         latice(nbp_lat-1,:) = nb_ice(ngrid,:)
     258         lonice(nbp_lon,:) = nb_ice(ngrid,:)
    257259     
    258260     
    … …  
    271273   
    272274         ! loop over GCM latitudes. CONSIDER ONLY NORTHERN HEMISPHERE
    273          do i=1,jjm/2
     275         do i=1,(nbp_lat-1)/2
    274276          step  = 1. ! threshold to add ice cap
    275277          count = 0. ! number of ice GCM caps at this latitude
    … …  
    280282          ! put ice caps while there is not enough ice,
    281283          ! as long as the threshold is above 20%
    282           do while ( (count .le. ratiolat*iim ) .and. (step .ge. 0.2))
     284          do while ((count.le.ratiolat*nbp_lon).and.(step.ge.0.2))
    283285           count = 0.
    284286           ! loop over GCM longitudes
    285            do j=1,iim
     287           do j=1,nbp_lon
    286288            ! if the detected ice ratio in the GCM grid point
    287289            ! is more than 'step', then add ice
    288             if (real(nb_ice((i-1)*iim+1+j,2))
    289      &        / real(nb_ice((i-1)*iim+1+j,1)) .ge. step) then
    290                   watercaptag_glo((i-1)*iim+1+j) = .true.
     290            if (real(nb_ice((i-1)*nbp_lon+1+j,2))
     291     &        / real(nb_ice((i-1)*nbp_lon+1+j,1)) .ge. step) then
     292                  watercaptag_glo((i-1)*nbp_lon+1+j) = .true.
    291293                  count = count + 1
    292294            endif
    293            enddo ! of do j=1,iim
    294            !print*, 'step',step,count,ratiolat*iim
     295           enddo ! of do j=1,nbp_lon
     296           !print*, 'step',step,count,ratiolat*nbp_lon
    295297           step = step - 0.01
    296298          enddo ! of do while
    297           !print*, 'step',step,count,ratiolat*iim
     299          !print*, 'step',step,count,ratiolat*nbp_lon
    298300
    299301         enddo ! of do i=1,jjm/2
    … …  
    304306         print*,'Surfini: predefined ice caps'
    305307     
    306          if ((iim .eq. 32) .and. (jjm .eq. 24)) then ! 32x24
     308         if ((nbp_lon.eq.32).and.((nbp_lat-1).eq.24)) then ! 32x24
    307309           
    308310          print*,'water ice caps distribution for 32x24 resolution'
    … …  
    317319!---------------------   OUTLIERS  ----------------------------
    318320
    319          else if ((iim .eq. 64) .and. (jjm .eq. 48)) then ! 64x48
     321         else if ((nbp_lon.eq.64).and.((nbp_lat-1).eq.48)) then ! 64x48
    320322
    321323          print*,'water ice caps distribution for 64x48 resolution'
    … …  
    355357       
    356358          print*,'No predefined ice location for this resolution :',
    357      &           iim,jjm
     359     &           nbp_lon,nbp_lat-1
    358360          print*,'Please change icelocationmode in surfini.F'
    359361          print*,'Or add some new definitions ...'

  • trunk/LMDZ.MARS/libf/phymars/writediagfi.F

    r1525 r1528  
    4040!=================================================================
    4141      use surfdat_h, only: phisfi
     42      use comgeomphy, only: airephy
    4243      use time_phylmdz_mod, only: ecritphy, day_step, iphysiq, day_ini
    4344      USE mod_phys_lmdz_para, only : is_parallel, is_mpi_root,
    4445     &                               is_master, gather
    45       USE mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo
     46      USE mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo,
     47     &                              nbp_lon, nbp_lat, nbp_lev
    4648      implicit none
    4749
    4850! Commons
    49 #include "dimensions.h"
    50 #include "paramet.h"
    51 #include "comgeom.h"
    52 #include "netcdf.inc"
     51      include "netcdf.inc"
    5352
    5453! Arguments on input:
    … …  
    5655      character (len=*),intent(in) :: nom,titre,unite
    5756      integer,intent(in) :: dim
    58       real,intent(in) :: px(ngrid,llm)
     57      real,intent(in) :: px(ngrid,nbp_lev)
    5958
    6059! Local variables:
    6160
    62       real*4 dx3(iip1,jjp1,llm) ! to store a 3D data set
    63       real*4 dx2(iip1,jjp1)     ! to store a 2D (surface) data set
    64       real*4 dx1(llm)           ! to store a 1D (column) data set
     61      real*4 dx3(nbp_lon+1,nbp_lat,nbp_lev) ! to store a 3D data set
     62      real*4 dx2(nbp_lon+1,nbp_lat)     ! to store a 2D (surface) data set
     63      real*4 dx1(nbp_lev)           ! to store a 1D (column) data set
    6564      real*4 dx0
    6665
    6766      real*4,save :: date
    6867
    69       REAL phis(ip1jmp1)
     68      REAL phis((nbp_lon+1),nbp_lat)
     69      REAL area((nbp_lon+1),nbp_lat)
    7070
    7171      integer irythme
    7272      integer ierr,ierr2
    73       integer iq
    74       integer i,j,l,zmax , ig0
     73      integer i,j,l, ig0
    7574
    7675      integer,save :: zitau=0
    … …  
    9897#ifdef CPP_PARA
    9998! Added to work in parallel mode
    100       real dx3_glop(klon_glo,llm)
    101       real dx3_glo(iim,jjp1,llm) ! to store a global 3D data set
     99      real dx3_glop(klon_glo,nbp_lev)
     100      real dx3_glo(nbp_lon,nbp_lat,nbp_lev) ! to store a global 3D data set
    102101      real dx2_glop(klon_glo)
    103       real dx2_glo(iim,jjp1)     ! to store a global 2D (surface) data set
     102      real dx2_glo(nbp_lon,nbp_lat)     ! to store a global 2D (surface) data set
    104103      real px2(ngrid)
    105 !      real dx1_glo(llm)          ! to store a 1D (column) data set
     104!      real dx1_glo(nbp_lev)          ! to store a 1D (column) data set
    106105!      real dx0_glo
    107106      real phisfi_glo(klon_glo) ! surface geopotential on global physics grid
     107      real areafi_glo(klon_glo) ! mesh area on global physics grid
    108108#else
    109109      real phisfi_glo(ngrid) ! surface geopotential on global physics grid
     110      real areafi_glo(ngrid) ! mesh area on global physics grid
    110111#endif
    111112
    … …  
    181182          ! Gather phisfi() geopotential on physics grid
    182183          call Gather(phisfi,phisfi_glo)
     184          ! Gather airephy() mesh area on physics grid
     185          call Gather(airephy,areafi_glo)
    183186#else
    184187         phisfi_glo(:)=phisfi(:)
     188         areafi_glo(:)=airephy(:)
    185189#endif
    186190
    … …  
    209213         ierr = NF_ENDDEF(nid)
    210214
     215         ! Build phis() and area()
     216         do i=1,nbp_lon+1 ! poles
     217           phis(i,1)=phisfi_glo(1)
     218           phis(i,nbp_lat)=phisfi_glo(klon_glo)
     219           ! for area, divide at the poles by nbp_lon
     220           area(i,1)=areafi_glo(1)/nbp_lon
     221           area(i,nbp_lat)=areafi_glo(klon_glo)/nbp_lon
     222         enddo
     223         do j=2,nbp_lat-1
     224           ig0= 1+(j-2)*nbp_lon
     225           do i=1,nbp_lon
     226              phis(i,j)=phisfi_glo(ig0+i)
     227              area(i,j)=areafi_glo(ig0+i)
     228           enddo
     229           ! handle redundant point in longitude
     230           phis(nbp_lon+1,j)=phis(1,j)
     231           area(nbp_lon+1,j)=area(1,j)
     232         enddo
     233         
    211234         ! write "header" of file (longitudes, latitudes, geopotential, ...)
    212          call gr_fi_dyn(1,size(phisfi_glo),iip1,jjp1,phisfi_glo,phis)
    213          call iniwrite(nid,day_ini,phis)
     235         call iniwrite(nid,day_ini,phis,area)
    214236
    215237         endif ! of if (is_master)
    … …  
    290312            call Grid1Dto2D_glo(dx3_glop,dx3_glo)
    291313            ! copy dx3_glo() to dx3(:) and add redundant longitude
    292             dx3(1:iim,:,:)=dx3_glo(1:iim,:,:)
    293             dx3(iip1,:,:)=dx3(1,:,:)
     314            dx3(1:nbp_lon,:,:)=dx3_glo(1:nbp_lon,:,:)
     315            dx3(nbp_lon+1,:,:)=dx3(1,:,:)
    294316          endif
    295317!$OMP END MASTER
    … …  
    298320!         Passage variable physique -->  variable dynamique
    299321!         recast (copy) variable from physics grid to dynamics grid
    300            DO l=1,llm
    301              DO i=1,iip1
     322           DO l=1,nbp_lev
     323             DO i=1,nbp_lon+1
    302324                dx3(i,1,l)=px(1,l)
    303                 dx3(i,jjp1,l)=px(ngrid,l)
     325                dx3(i,nbp_lat,l)=px(ngrid,l)
    304326             ENDDO
    305              DO j=2,jjm
    306                 ig0= 1+(j-2)*iim
    307                 DO i=1,iim
     327             DO j=2,nbp_lat-1
     328                ig0= 1+(j-2)*nbp_lon
     329                DO i=1,nbp_lon
    308330                   dx3(i,j,l)=px(ig0+i,l)
    309331                ENDDO
    310                 dx3(iip1,j,l)=dx3(1,j,l)
     332                dx3(nbp_lon+1,j,l)=dx3(1,j,l)
    311333             ENDDO
    312334           ENDDO
    … …  
    338360           corner(4)=ntime
    339361
    340            edges(1)=iip1
    341            edges(2)=jjp1
    342            edges(3)=llm
     362           edges(1)=nbp_lon+1
     363           edges(2)=nbp_lat
     364           edges(3)=nbp_lev
    343365           edges(4)=1
    344366!#ifdef NC_DOUBLE
    … …  
    374396            call Grid1Dto2D_glo(dx2_glop,dx2_glo)
    375397            ! copy dx2_glo() to dx2(:) and add redundant longitude
    376             dx2(1:iim,:)=dx2_glo(1:iim,:)
    377             dx2(iip1,:)=dx2(1,:)
     398            dx2(1:nbp_lon,:)=dx2_glo(1:nbp_lon,:)
     399            dx2(nbp_lon+1,:)=dx2(1,:)
    378400          endif
    379401!$OMP END MASTER
    … …  
    384406!         recast (copy) variable from physics grid to dynamics grid
    385407
    386              DO i=1,iip1
     408             DO i=1,nbp_lon+1
    387409                dx2(i,1)=px(1,1)
    388                 dx2(i,jjp1)=px(ngrid,1)
     410                dx2(i,nbp_lat)=px(ngrid,1)
    389411             ENDDO
    390              DO j=2,jjm
    391                 ig0= 1+(j-2)*iim
    392                 DO i=1,iim
     412             DO j=2,nbp_lat-1
     413                ig0= 1+(j-2)*nbp_lon
     414                DO i=1,nbp_lon
    393415                   dx2(i,j)=px(ig0+i,1)
    394416                ENDDO
    395                 dx2(iip1,j)=dx2(1,j)
     417                dx2(nbp_lon+1,j)=dx2(1,j)
    396418             ENDDO
    397419#endif
    … …  
    420442           corner(2)=1
    421443           corner(3)=ntime
    422            edges(1)=iip1
    423            edges(2)=jjp1
     444           edges(1)=nbp_lon+1
     445           edges(2)=nbp_lat
    424446           edges(3)=1
    425447
    … …  
    451473!         Passage variable physique -->  physique dynamique
    452474!         recast (copy) variable from physics grid to dynamics grid
    453           do l=1,llm
     475          do l=1,nbp_lev
    454476            dx1(l)=px(1,l)
    455477          enddo
    … …  
    473495           corner(2)=ntime
    474496           
    475            edges(1)=llm
     497           edges(1)=nbp_lev
    476498           edges(2)=1
    477499!#ifdef NC_DOUBLE

  • trunk/LMDZ.MARS/libf/phymars/writediagsoil.F90

    r1525 r1528  
    1212! Modifs: Aug.2010 Ehouarn: enforce outputs to be real*4
    1313
    14 use comsoil_h, only: nsoilmx
     14use comsoil_h, only: nsoilmx, inertiedat
     15use comgeomphy, only: airephy
    1516use time_phylmdz_mod, only: ecritphy, day_step, iphysiq
    1617use mod_phys_lmdz_para, only : is_mpi_root, is_master, gather
    17 use mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo
     18use mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo, &
     19                              nbp_lon, nbp_lat
    1820
    1921implicit none
    2022
    21 #include"dimensions.h"
    22 #include"paramet.h"
    23 !#include"control.h"
    24 !#include"comsoil.h"
    25 #include"netcdf.inc"
     23include"netcdf.inc"
    2624
    2725! Arguments:
    … …  
    3331integer,intent(in) :: dimpx ! dimension of the variable (3,2 or 0)
    3432real,dimension(ngrid,nsoilmx),intent(in) :: px ! variable
    35 ! Note: nsoilmx is a parameter set in 'comsoil_h'
    3633
    3734! Local variables:
    38 real*4,dimension(iip1,jjp1,nsoilmx) :: data3 ! to store 3D data
    39 ! Note iip1,jjp1 known from paramet.h; nsoilmx known from comsoil_h
    40 real*4,dimension(iip1,jjp1) :: data2 ! to store 2D data
     35real*4,dimension(nbp_lon+1,nbp_lat,nsoilmx) :: data3 ! to store 3D data
     36real*4,dimension(nbp_lon+1,nbp_lat) :: data2 ! to store 2D data
    4137real*4 :: data0 ! to store 0D data
    4238integer :: i,j,l ! for loops
    … …  
    4440
    4541real*4,save :: date ! time counter (in elapsed days)
     42
     43real :: inertia((nbp_lon+1),nbp_lat,nsoilmx)
     44real :: area((nbp_lon+1),nbp_lat)
     45
     46real :: inertiafi_glo(klon_glo,nsoilmx)
     47real :: areafi_glo(klon_glo)
     48
    4649integer,save :: isample ! sample rate at which data is to be written to output
    4750integer,save :: ntime=0 ! counter to internally store time steps
    … …  
    6164! Added to work in parallel mode
    6265real dx3_glop(klon_glo,nsoilmx)
    63 real dx3_glo(iim,jjp1,nsoilmx) ! to store a global 3D data set
     66real dx3_glo(nbp_lon,nbp_lat,nsoilmx) ! to store a global 3D data set
    6467real dx2_glop(klon_glo)
    65 real dx2_glo(iim,jjp1)     ! to store a global 2D (surface) data set
     68real dx2_glo(nbp_lon,nbp_lat)     ! to store a global 2D (surface) data set
    6669real px2(ngrid)
    6770#endif
    … …  
    9295    stop
    9396   endif
     97
     98#ifdef CPP_PARA
     99   ! Gather inertiedat() soil thermal inertia on physics grid
     100   call Gather(inertiedat,inertiafi_glo)
     101   ! Gather airephy() mesh area on physics grid
     102   call Gather(airephy,areafi_glo)
     103#else
     104         inertiafi_glo(:,:)=inertiedat(:,:)
     105         areafi_glo(:)=airephy(:)
     106#endif
     107
     108   ! build inertia() and area()
     109   do i=1,nbp_lon+1 ! poles
     110     inertia(i,1,1:nsoilmx)=inertiafi_glo(1,1:nsoilmx)
     111     inertia(i,nbp_lat,1:nsoilmx)=inertiafi_glo(klon_glo,1:nsoilmx)
     112     ! for area, divide at the poles by nbp_lon
     113     area(i,1)=areafi_glo(1)/nbp_lon
     114     area(i,nbp_lat)=areafi_glo(klon_glo)/nbp_lon
     115   enddo
     116   do j=2,nbp_lat-1
     117     ig0= 1+(j-2)*nbp_lon
     118     do i=1,nbp_lon
     119        inertia(i,j,1:nsoilmx)=inertiafi_glo(ig0+i,1:nsoilmx)
     120        area(i,j)=areafi_glo(ig0+i)
     121     enddo
     122     ! handle redundant point in longitude
     123     inertia(nbp_lon+1,j,1:nsoilmx)=inertia(1,j,1:nsoilmx)
     124     area(nbp_lon+1,j)=area(1,j)
     125   enddo
     126   
     127   ! write "header" of file (longitudes, latitudes, geopotential, ...)
     128   call iniwritesoil(nid,ngrid,inertia,area)
     129
    94130  endif ! of if (is_master)
    95 
    96   ! Define dimensions and axis attributes
    97   call iniwritesoil(nid,ngrid)
    98131 
    99132  ! set zitau to -1 to be compatible with zitau incrementation step below
    … …  
    149182    call Grid1Dto2D_glo(dx3_glop,dx3_glo)
    150183    ! copy dx3_glo() to dx3(:) and add redundant longitude
    151     data3(1:iim,:,:)=dx3_glo(1:iim,:,:)
    152     data3(iip1,:,:)=data3(1,:,:)
     184    data3(1:nbp_lon,:,:)=dx3_glo(1:nbp_lon,:,:)
     185    data3(nbp_lon+1,:,:)=data3(1,:,:)
    153186  endif
    154187!$OMP END MASTER
    … …  
    157190  do l=1,nsoilmx
    158191    ! handle the poles
    159     do i=1,iip1
     192    do i=1,nbp_lon+1
    160193      data3(i,1,l)=px(1,l)
    161       data3(i,jjp1,l)=px(ngrid,l)
     194      data3(i,nbp_lat,l)=px(ngrid,l)
    162195    enddo
    163196    ! rest of the grid
    164     do j=2,jjm
    165       ig0=1+(j-2)*iim
    166       do i=1,iim
     197    do j=2,nbp_lat-1
     198      ig0=1+(j-2)*nbp_lon
     199      do i=1,nbp_lon
    167200        data3(i,j,l)=px(ig0+i,l)
    168201      enddo
    169       data3(iip1,j,l)=data3(1,j,l) ! extra (modulo) longitude
     202      data3(nbp_lon+1,j,l)=data3(1,j,l) ! extra (modulo) longitude
    170203    enddo
    171204  enddo
    … …  
    196229  corners(4)=ntime
    197230 
    198   edges(1)=iip1
    199   edges(2)=jjp1
     231  edges(1)=nbp_lon+1
     232  edges(2)=nbp_lat
    200233  edges(3)=nsoilmx
    201234  edges(4)=1
    … …  
    224257    call Grid1Dto2D_glo(dx2_glop,dx2_glo)
    225258    ! copy dx3_glo() to dx3(:) and add redundant longitude
    226     data2(1:iim,:)=dx2_glo(1:iim,:)
    227     data2(iip1,:)=data2(1,:)
     259    data2(1:nbp_lon,:)=dx2_glo(1:nbp_lon,:)
     260    data2(nbp_lon+1,:)=data2(1,:)
    228261  endif
    229262!$OMP END MASTER
    … …  
    231264#else
    232265  ! handle the poles
    233   do i=1,iip1
     266  do i=1,nbp_lon+1
    234267    data2(i,1)=px(1,1)
    235     data2(i,jjp1)=px(ngrid,1)
     268    data2(i,nbp_lat)=px(ngrid,1)
    236269  enddo
    237270  ! rest of the grid
    238   do j=2,jjm
    239     ig0=1+(j-2)*iim
    240     do i=1,iim
     271  do j=2,nbp_lat-1
     272    ig0=1+(j-2)*nbp_lon
     273    do i=1,nbp_lon
    241274      data2(i,j)=px(ig0+i,1)
    242275    enddo
    243     data2(iip1,j)=data2(1,j) ! extra (modulo) longitude
     276    data2(nbp_lon+1,j)=data2(1,j) ! extra (modulo) longitude
    244277  enddo
    245278#endif
    … …  
    267300  corners(3)=ntime
    268301 
    269   edges(1)=iip1
    270   edges(2)=jjp1
     302  edges(1)=nbp_lon+1
     303  edges(2)=nbp_lat
    271304  edges(3)=1
    272305 

  • trunk/LMDZ.MARS/libf/phymars/wstats.F90

    r1422 r1528  
    22
    33use mod_phys_lmdz_para, only : is_mpi_root, is_master, gather, klon_mpi_begin
    4 use mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo
    5 
     4use mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo, &
     5                              nbp_lon, nbp_lat, nbp_lev
    66implicit none
    77
    8 #include "dimensions.h"
    9 #include "statto.h"
    10 #include "netcdf.inc"
     8include "statto.h"
     9include "netcdf.inc"
    1110
    1211integer,intent(in) :: ngrid
    1312character (len=*),intent(in) :: nom,titre,unite
    1413integer,intent(in) :: dim
    15 integer,parameter :: iip1=iim+1
    16 integer,parameter :: jjp1=jjm+1
    17 real,intent(in) :: px(ngrid,llm)
    18 real, dimension(iip1,jjp1,llm) :: mean3d,sd3d,dx3
    19 real, dimension(iip1,jjp1) :: mean2d,sd2d,dx2
     14real,intent(in) :: px(ngrid,nbp_lev)
     15real, dimension(nbp_lon+1,nbp_lat,nbp_lev) :: mean3d,sd3d,dx3
     16real, dimension(nbp_lon+1,nbp_lat) :: mean2d,sd2d,dx2
    2017character (len=50) :: namebis
    2118character (len=50), save :: firstvar
    … …  
    3128! Added to work in parallel mode
    3229#ifdef CPP_PARA
    33 real px3_glop(klon_glo,llm) ! to store a 3D data set on global physics grid
    34 real px3_glo(iim,jjp1,llm) ! to store a global 3D data set on global lonxlat grid
     30real px3_glop(klon_glo,nbp_lev) ! to store a 3D data set on global physics grid
     31real px3_glo(nbp_lon,nbp_lat,nbp_lev) ! to store a global 3D data set on global lonxlat grid
    3532real px2_glop(klon_glo) ! to store a 2D data set on global physics grid
    36 real px2_glo(iim,jjp1) ! to store a 2D data set on global lonxlat grid
     33real px2_glo(nbp_lon,nbp_lat) ! to store a 2D data set on global lonxlat grid
    3734real px2(ngrid)
    38 real px3(ngrid,llm)
     35real px3(ngrid,nbp_lev)
    3936#else
    4037! When not running in parallel mode:
    41 real px3_glop(ngrid,llm) ! to store a 3D data set on global physics grid
    42 real px3_glo(iim,jjp1,llm) ! to store a global 3D data set on global lonxlat grid
     38real px3_glop(ngrid,nbp_lev) ! to store a 3D data set on global physics grid
     39real px3_glo(nbp_lon,nbp_lat,nbp_lev) ! to store a global 3D data set on global lonxlat grid
    4340real px2_glop(ngrid) ! to store a 2D data set on global physics grid
    44 real px2_glo(iim,jjp1) ! to store a 2D data set on global lonxlat grid
     41real px2_glo(nbp_lon,nbp_lat) ! to store a 2D data set on global lonxlat grid
    4542#endif
    4643
    … …  
    6461#ifdef CPP_PARA
    6562 if (dim.eq.3) then
    66   px3(1:ngrid,1:llm)=px(1:ngrid,1:llm)
     63  px3(1:ngrid,1:nbp_lev)=px(1:ngrid,1:nbp_lev)
    6764  ! Gather fieds on a "global" (without redundant longitude) array
    6865  call Gather(px3,px3_glop)
    … …  
    7168    call Grid1Dto2D_glo(px3_glop,px3_glo)
    7269    ! copy dx3_glo() to dx3(:) and add redundant longitude
    73     dx3(1:iim,:,:)=px3_glo(1:iim,:,:)
    74     dx3(iip1,:,:)=dx3(1,:,:)
     70    dx3(1:nbp_lon,:,:)=px3_glo(1:nbp_lon,:,:)
     71    dx3(nbp_lon+1,:,:)=dx3(1,:,:)
    7572  endif
    7673!$OMP END MASTER
    … …  
    8481            call Grid1Dto2D_glo(px2_glop,px2_glo)
    8582            ! copy px2_glo() to dx2(:) and add redundant longitude
    86             dx2(1:iim,:)=px2_glo(1:iim,:)
    87             dx2(iip1,:)=dx2(1,:)
     83            dx2(1:nbp_lon,:)=px2_glo(1:nbp_lon,:)
     84            dx2(nbp_lon+1,:)=dx2(1,:)
    8885          endif
    8986!$OMP END MASTER
    … …  
    9289#else
    9390  if (dim.eq.3) then
    94     px3_glop(:,1:llm)=px(:,1:llm)
     91    px3_glop(:,1:nbp_lev)=px(:,1:nbp_lev)
    9592!  Passage variable physique -->  variable dynamique
    96     DO l=1,llm
    97       DO i=1,iim
     93    DO l=1,nbp_lev
     94      DO i=1,nbp_lon
    9895         px3_glo(i,1,l)=px(1,l)
    99          px3_glo(i,jjp1,l)=px(ngrid,l)
     96         px3_glo(i,nbp_lat,l)=px(ngrid,l)
    10097      ENDDO
    101       DO j=2,jjm
    102          ig0= 1+(j-2)*iim
    103          DO i=1,iim
     98      DO j=2,nbp_lat-1
     99         ig0= 1+(j-2)*nbp_lon
     100         DO i=1,nbp_lon
    104101            px3_glo(i,j,l)=px(ig0+i,l)
    105102         ENDDO
    … …  
    109106    px2_glop(:)=px(:,1)
    110107!    Passage variable physique -->  physique dynamique
    111    DO i=1,iim
     108   DO i=1,nbp_lon
    112109     px2_glo(i,1)=px(1,1)
    113      px2_glo(i,jjp1)=px(ngrid,1)
     110     px2_glo(i,nbp_lat)=px(ngrid,1)
    114111   ENDDO
    115    DO j=2,jjm
    116      ig0= 1+(j-2)*iim
    117      DO i=1,iim
     112   DO j=2,nbp_lat-1
     113     ig0= 1+(j-2)*nbp_lon
     114     DO i=1,nbp_lon
    118115        px2_glo(i,j)=px(ig0+i,1)
    119116     ENDDO
    … …  
    195192   if (dim.eq.3) then
    196193      start=(/1,1,1,indx/)
    197       sizes=(/iip1,jjp1,llm,1/)
     194      sizes=(/nbp_lon+1,nbp_lat,nbp_lev,1/)
    198195      mean3d(:,:,:)=0
    199196      sd3d(:,:,:)=0
    200197   else if (dim.eq.2) then
    201198      start=(/1,1,indx,0/)
    202       sizes=(/iip1,jjp1,1,0/)
     199      sizes=(/nbp_lon+1,nbp_lev,1,0/)
    203200      mean2d(:,:)=0
    204201      sd2d(:,:)=0
    … …  
    208205   if (dim.eq.3) then
    209206      start=(/1,1,1,indx/)
    210       sizes=(/iip1,jjp1,llm,1/)
     207      sizes=(/nbp_lon+1,nbp_lat,nbp_lev,1/)
    211208#ifdef NC_DOUBLE
    212209      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,sizes,mean3d)
    … …  
    223220   else if (dim.eq.2) then
    224221      start=(/1,1,indx,0/)
    225       sizes=(/iip1,jjp1,1,0/)
     222      sizes=(/nbp_lon+1,nbp_lat,1,0/)
    226223#ifdef NC_DOUBLE
    227224      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,sizes,mean2d)
    … …  
    242239
    243240if (dim.eq.3) then
    244   dx3(1:iim,:,:)=px3_glo(:,:,:)
    245   dx3(iip1,:,:)=dx3(1,:,:)
     241  dx3(1:nbp_lon,:,:)=px3_glo(:,:,:)
     242  dx3(nbp_lon+1,:,:)=dx3(1,:,:)
    246243else ! dim.eq.2
    247   dx2(1:iim,:)=px2_glo(:,:)
    248   dx2(iip1,:)=dx2(1,:)
     244  dx2(1:nbp_lon,:)=px2_glo(:,:)
     245  dx2(nbp_lon+1,:)=dx2(1,:)
    249246endif
    250247
    … …  
    287284!======================================================
    288285subroutine inivar(nid,varid,ngrid,dim,indx,px,ierr)
     286use mod_grid_phy_lmdz, only : nbp_lon, nbp_lat, nbp_lev
    289287
    290288implicit none
    291289
    292 include "dimensions.h"
    293290include "netcdf.inc"
    294291
    295292integer, intent(in) :: nid,varid,dim,indx,ngrid
    296 real, dimension(ngrid,llm), intent(in) :: px
     293real, dimension(ngrid,nbp_lev), intent(in) :: px
    297294integer, intent(out) :: ierr
    298 
    299 integer,parameter :: iip1=iim+1
    300 integer,parameter :: jjp1=jjm+1
    301295
    302296integer :: l,i,j,ig0
    303297integer, dimension(4) :: start,sizes
    304 real, dimension(iip1,jjp1,llm) :: dx3
    305 real, dimension(iip1,jjp1) :: dx2
     298real, dimension(nbp_lon+1,nbp_lat,nbp_lev) :: dx3
     299real, dimension(nbp_lon+1,nbp_lat) :: dx2
    306300
    307301if (dim.eq.3) then
    308302
    309303   start=(/1,1,1,indx/)
    310    sizes=(/iip1,jjp1,llm,1/)
     304   sizes=(/nbp_lon+1,nbp_lat,nbp_lev,1/)
    311305
    312306!  Passage variable physique -->  variable dynamique
    313307
    314    DO l=1,llm
    315       DO i=1,iip1
     308   DO l=1,nbp_lev
     309      DO i=1,nbp_lon+1
    316310         dx3(i,1,l)=px(1,l)
    317          dx3(i,jjp1,l)=px(ngrid,l)
     311         dx3(i,nbp_lat,l)=px(ngrid,l)
    318312      ENDDO
    319       DO j=2,jjm
    320          ig0= 1+(j-2)*iim
    321          DO i=1,iim
     313      DO j=2,nbp_lat-1
     314         ig0= 1+(j-2)*nbp_lon
     315         DO i=1,nbp_lon
    322316            dx3(i,j,l)=px(ig0+i,l)
    323317         ENDDO
    324          dx3(iip1,j,l)=dx3(1,j,l)
     318         dx3(nbp_lon+1,j,l)=dx3(1,j,l)
    325319      ENDDO
    326320   ENDDO
    … …  
    335329
    336330      start=(/1,1,indx,0/)
    337       sizes=(/iip1,jjp1,1,0/)
     331      sizes=(/nbp_lon+1,nbp_lat,1,0/)
    338332
    339333!    Passage variable physique -->  physique dynamique
    340334
    341   DO i=1,iip1
     335  DO i=1,nbp_lon+1
    342336     dx2(i,1)=px(1,1)
    343      dx2(i,jjp1)=px(ngrid,1)
     337     dx2(i,nbp_lat)=px(ngrid,1)
    344338  ENDDO
    345   DO j=2,jjm
    346      ig0= 1+(j-2)*iim
    347      DO i=1,iim
     339  DO j=2,nbp_lat-1
     340     ig0= 1+(j-2)*nbp_lon
     341     DO i=1,nbp_lon
    348342        dx2(i,j)=px(ig0+i,1)
    349343     ENDDO
    350      dx2(iip1,j)=dx2(1,j)
     344     dx2(nbp_lon+1,j)=dx2(1,j)
    351345  ENDDO
    352346
    … …  
    376370implicit none
    377371
    378 #include "netcdf.inc"
     372include "netcdf.inc"
    379373
    380374integer,intent(in) :: nid ! NetCDF file ID
Note: See TracChangeset for help on using the changeset viewer.