Changeset 1532


Ignore:
Timestamp:
Apr 7, 2016, 3:53:15 PM (9 years ago)
Author:
emillour
Message:

Mars GCM:

  • Some fixes for buggy outputs in 1D introduced by previous code modifications.
  • made statto.h a module.
  • ecritphy in dyn3d/control_mod.F90 should be an integer, not a real.

EM

Location:
trunk/LMDZ.MARS
Files:
9 edited
1 moved

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.MARS/README

    r1528 r1532  
    22432243- Added "ioipsl_getin_p_mod.F90" (getin_p routine) in phy_common to
    22442244  correctly read in parameters from *.def files in a parallel environment.
     2245
     2246== 07/04/2016 == EM
     2247- Some fixes for buggy outputs in 1D introduced by previous code modifications.
     2248- made statto.h a module.
     2249- ecritphy in dyn3d/control_mod.F90 should be an integer, not a real.

  • trunk/LMDZ.MARS/libf/dyn3d/control_mod.F90

    r1416 r1532  
    1212  integer,save :: anneeref ! reference year # ! not used
    1313  real,save :: periodav
    14   real,save :: ecritphy ! output data in "diagfi.nc" every ecritphy dynamical steps
     14  integer,save :: ecritphy ! output data in "diagfi.nc" every ecritphy dynamical steps
    1515  integer,save :: ecritstart ! output data in "start.nc" every ecritstart dynamical steps
    1616  real,save :: timestart ! time start for run in "start.nc"

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

    r1528 r1532  
    11      subroutine inistats(ierr)
    22
     3      use statto_mod, only: istats,istime
    34      use mod_phys_lmdz_para, only : is_master
    45      USE comvert_mod, ONLY: ap,bp,aps,bps,preff,pseudoalt,presnivs
    … …  
    910      implicit none
    1011
    11       include "statto.h"
    1212      include "netcdf.inc"
    1313
    … …  
    1616      integer :: l,nsteppd
    1717      real, dimension(nbp_lev) ::  sig_s
    18       real :: lon_reg_ext(nbp_lon+1) ! extended longitudes
     18      real,allocatable :: lon_reg_ext(:) ! extended longitudes
    1919      integer :: idim_lat,idim_lon,idim_llm,idim_llmp1,idim_time
    2020      real, dimension(istime) :: lt
    2121      integer :: nvarid
    2222
     23
     24      IF (nbp_lon*nbp_lat==1) THEN
     25        ! 1D model
     26        ALLOCATE(lon_reg_ext(1))
     27      ELSE
     28        ! 3D model
     29        ALLOCATE(lon_reg_ext(nbp_lon+1))
     30      ENDIF
     31     
    2332      write (*,*)
    2433      write (*,*) '                        || STATS ||'
    … …  
    4655     
    4756      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)
     57      IF (nbp_lon*nbp_lat/=1) THEN
     58        ! In 3D, add extra redundant point (180 degrees,
     59        ! since lon_reg starts at -180)
     60        lon_reg_ext(nbp_lon+1)=-lon_reg_ext(1)
     61      ENDIF
    5062
    5163      if (is_master) then
    … …  
    5971
    6072      ierr = NF_DEF_DIM (nid, "latitude", nbp_lat, idim_lat)
    61       ierr = NF_DEF_DIM (nid, "longitude", nbp_lon+1, idim_lon)
     73      IF (nbp_lon*nbp_lat==1) THEN
     74        ierr = NF_DEF_DIM (nid, "longitude", 1, idim_lon)
     75      ELSE
     76        ierr = NF_DEF_DIM (nid, "longitude", nbp_lon+1, idim_lon)
     77      ENDIF
    6278      ierr = NF_DEF_DIM (nid, "altitude", nbp_lev, idim_llm)
    6379      ierr = NF_DEF_DIM (nid, "llmp1", nbp_lev+1, idim_llmp1)

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

    r1528 r1532  
    1       SUBROUTINE iniwrite(nid,idayref,phis,area)
     1      SUBROUTINE iniwrite(nid,idayref,phis,area,nbplon,nbplat)
    22
    33      use comsoil_h, only: mlayer, nsoilmx
    … …  
    3535      integer,intent(in) :: nid        ! NetCDF file ID
    3636      INTEGER*4,intent(in) :: idayref  ! date (initial date for this run)
    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)
     37      real,intent(in) :: phis(nbplon,nbp_lat) ! surface geopotential
     38      real,intent(in) :: area(nbplon,nbp_lat) ! mesh area (m2)
     39      integer,intent(in) :: nbplon,nbplat ! sizes of area and phis arrays
    3940
    4041c   Local:
    … …  
    4445      REAL tab_cntrl(length) ! run parameters are stored in this array
    4546      INTEGER ierr
    46       REAl :: lon_reg_ext(nbp_lon+1) ! extended longitudes
     47      REAl,ALLOCATABLE :: lon_reg_ext(:) ! extended longitudes
    4748
    4849      integer :: nvarid,idim_index,idim_rlonv
    … …  
    5152      integer, dimension(2) :: id 
    5253c-----------------------------------------------------------------------
     54
     55      IF (nbp_lon*nbp_lat==1) THEN
     56        ! 1D model
     57        ALLOCATE(lon_reg_ext(1))
     58      ELSE
     59        ! 3D model
     60        ALLOCATE(lon_reg_ext(nbp_lon+1))
     61      ENDIF
    5362
    5463      DO l=1,length
    … …  
    104113!      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
    105114      ierr = NF_DEF_DIM (nid, "latitude", nbp_lat, idim_rlatu)
    106       ierr = NF_DEF_DIM (nid, "longitude", nbp_lon+1, idim_rlonv)
     115      IF (nbp_lon*nbp_lat==1) THEN
     116        ierr = NF_DEF_DIM (nid, "longitude", 1, idim_rlonv)
     117      ELSE
     118        ierr = NF_DEF_DIM (nid, "longitude", nbp_lon+1, idim_rlonv)
     119      ENDIF
    107120!      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
    108121      ierr = NF_DEF_DIM (nid, "interlayer", (nbp_lev+1), idim_llmp1)
    … …  
    166179c
    167180c --------------------------
     181     
    168182      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)
     183      IF (nbp_lon*nbp_lat/=1) THEN
     184        ! In 3D, add extra redundant point (180 degrees,
     185        ! since lon_reg starts at -180)
     186        lon_reg_ext(nbp_lon+1)=-lon_reg_ext(1)
     187      ENDIF
    171188
    172189      ierr = NF_REDEF (nid)

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

    r1528 r1532  
    1 subroutine iniwritesoil(nid,ngrid,inertia,area)
     1subroutine iniwritesoil(nid,ngrid,inertia,area,nbplon,nbplat)
    22
    33! initialization routine for 'writediagoil'. Here we create/define
    … …  
    1717integer,intent(in) :: ngrid
    1818integer,intent(in) :: nid ! NetCDF output file ID
    19 real,intent(in) :: inertia(nbp_lon+1,nbp_lat,nsoilmx)
    20 real,intent(in) :: area(nbp_lon+1,nbp_lat) ! mesh area (m2)
     19real,intent(in) :: inertia(nbplon,nbplat,nsoilmx)
     20real,intent(in) :: area(nbplon,nbp_lat) ! mesh area (m2)
     21integer,intent(in) :: nbplon,nbplat ! sizes of area
    2122
    2223! Local variables:
    … …  
    3334real,dimension(nbp_lon+1,nbp_lat,nsoilmx) :: data3 ! to store 3D data
    3435integer :: i,j,l,ig0
    35 real :: lon_reg_ext(nbp_lon+1) ! extended longitudes
     36real,allocatable :: lon_reg_ext(:) ! extended longitudes
     37
     38
     39if (nbp_lon*nbp_lat==1) then
     40  ! 1D model
     41  allocate(lon_reg_ext(1))
     42else
     43  ! 3D model
     44  allocate(lon_reg_ext(nbp_lon+1))
     45endif
    3646
    3747! 1. Define the dimensions
    … …  
    4050
    4151! Define the dimensions
    42 ierr=NF_DEF_DIM(nid,"longitude",nbp_lon+1,idim_rlonv)
     52if (nbp_lon*nbp_lat==1) then
     53  ierr=NF_DEF_DIM(nid,"longitude",1,idim_rlonv)
     54else
     55  ierr=NF_DEF_DIM(nid,"longitude",nbp_lon+1,idim_rlonv)
     56endif
    4357if (ierr.ne.NF_NOERR) then
    4458  write(*,*)"iniwritesoil: Error, could not define longitude dimension"
    … …  
    8296
    8397lon_reg_ext(1:nbp_lon)=lon_reg(1:nbp_lon)
    84 !add extra redundant point (180 degrees, since lon_reg starts at -180
    85 lon_reg_ext(nbp_lon+1)=-lon_reg_ext(1)
     98if (nbp_lon*nbp_lat/=1) then ! in 3D only:
     99  ! add extra redundant point (180 degrees, since lon_reg starts at -180
     100  lon_reg_ext(nbp_lon+1)=-lon_reg_ext(1)
     101endif
    86102
    87103! Write longitude to file

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

    r1528 r1532  
    1010!  Yann W. july 2003
    1111
     12use statto_mod, only: istime,count
    1213use mod_phys_lmdz_para, only : is_master
    13 use mod_grid_phy_lmdz, only : nbp_lon, nbp_lat, nbp_lev
     14use mod_grid_phy_lmdz, only : nbp_lon, nbp_lat, nbp_lev, klon_glo
    1415
    1516implicit none
    1617
    17 include "statto.h"
    1818include "netcdf.inc"
    1919
    … …  
    2222integer, dimension(5) :: dimids
    2323character (len=50) :: name,nameout,units,title
    24 real, dimension(nbp_lon+1,nbp_lat,nbp_lev) :: sum3d,square3d,mean3d,sd3d
    25 real, dimension(nbp_lon+1,nbp_lat) :: sum2d,square2d,mean2d,sd2d
     24real,allocatable :: sum3d(:,:,:),square3d(:,:,:),mean3d(:,:,:),sd3d(:,:,:)
     25real,allocatable :: sum2d(:,:),square2d(:,:),mean2d(:,:),sd2d(:,:)
    2626real, dimension(istime) :: time
    2727real, dimension(nbp_lat) :: lat
    28 real, dimension(nbp_lon+1) :: lon
     28real,allocatable :: lon(:)
    2929real, dimension(nbp_lev) :: alt
    3030logical :: lcopy=.true.
    … …  
    3838if (is_master) then
    3939! only the master needs do this
     40if (klon_glo>1) then
     41  allocate(lon(nbp_lon+1))
     42  allocate(sum3d(nbp_lon+1,nbp_lat,nbp_lev))
     43  allocate(square3d(nbp_lon+1,nbp_lat,nbp_lev))
     44  allocate(mean3d(nbp_lon+1,nbp_lat,nbp_lev))
     45  allocate(sd3d(nbp_lon+1,nbp_lat,nbp_lev))
     46  allocate(sum2d(nbp_lon+1,nbp_lat))
     47  allocate(square2d(nbp_lon+1,nbp_lat))
     48  allocate(mean2d(nbp_lon+1,nbp_lat))
     49  allocate(sd2d(nbp_lon+1,nbp_lat))
     50else ! 1D model case
     51  allocate(lon(1))
     52  allocate(sum3d(1,1,nbp_lev))
     53  allocate(square3d(1,1,nbp_lev))
     54  allocate(mean3d(1,1,nbp_lev))
     55  allocate(sd3d(1,1,nbp_lev))
     56  allocate(sum2d(1,1))
     57  allocate(square2d(1,1))
     58  allocate(mean2d(1,1))
     59  allocate(sd2d(1,1))
     60endif
    4061
    4162ierr = NF_OPEN("stats.nc",NF_WRITE,nid)
    … …  
    105126!      dimout(4)=timeid
    106127
    107       size=(/nbp_lon+1,nbp_lat,nbp_lev,1/)
     128      if (klon_glo>1) then ! general case
     129        size=(/nbp_lon+1,nbp_lat,nbp_lev,1/)
     130      else ! 1D model
     131        size=(/1,1,nbp_lev,1/)
     132      endif
    108133      do lt=1,istime
    109134         start=(/1,1,1,lt/)
    … …  
    135160!      dimout(3)=timeid
    136161
    137       size=(/nbp_lon+1,nbp_lat,1,0/)
     162      if (klon_glo>1) then ! general case
     163        size=(/nbp_lon+1,nbp_lat,1,0/)
     164      else
     165        size=(/1,1,1,0/)
     166      endif
    138167      do lt=1,istime
    139168         start=(/1,1,lt,0/)

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

    r1531 r1532  
     1MODULE statto_mod
     2IMPLICIT NONE 
    13
    2 !  statto:
     4!  statto_mod:
    35!     This include file controls the production of statistics.
    46!     Some variables could be set in a namelist, but it is easier to
    … …  
    3133        integer, parameter :: cntrlsize=15
    3234
    33 !       common /sttcom/ dummy,nstore,istats,usdata
    34         common /sttcom/ nstore,istats,usdata,count
     35END MODULE statto_mod

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

    r1528 r1532  
    6363      real*4 dx1(nbp_lev)           ! to store a 1D (column) data set
    6464      real*4 dx0
     65      real*4 dx3_1d(1,nbp_lev) ! to store a profile with 1D model
     66      real*4 dx2_1d ! to store a surface value with 1D model
    6567
    6668      real*4,save :: date
     69!$OMP THREADPRIVATE(date)
    6770
    6871      REAL phis((nbp_lon+1),nbp_lat)
    … …  
    7578      integer,save :: zitau=0
    7679      character(len=20),save :: firstnom='1234567890'
     80!$OMP THREADPRIVATE(zitau,firstnom)
    7781
    7882! Ajouts
    7983      integer, save :: ntime=0
     84!$OMP THREADPRIVATE(ntime)
    8085      integer :: idim,varid
    8186      integer :: nid
    … …  
    9297      character(len=120),save :: nom_def(n_nom_def_max)
    9398      logical,save :: firstcall=.true.
     99!$OMP THREADPRIVATE(firstcall)  !diagfi_def,n_nom_def,nom_def read in diagfi.def
    94100     
    95 #ifndef MESOSCALE
    96 
    97101#ifdef CPP_PARA
    98102! Added to work in parallel mode
    … …  
    127131         firstcall=.false.
    128132
     133!$OMP MASTER
    129134  !      Open diagfi.def definition file if there is one:
    130135         open(99,file="diagfi.def",status='old',form='formatted',
    … …  
    150155            diagfi_def=.false.
    151156         endif
     157!$OMP END MASTER
     158!$OMP BARRIER
    152159      END IF ! of IF (firstcall)
    153160
    … …  
    214221
    215222         ! Build phis() and area()
    216          do i=1,nbp_lon+1 ! poles
     223         IF (klon_glo>1) THEN
     224          do i=1,nbp_lon+1 ! poles
    217225           phis(i,1)=phisfi_glo(1)
    218226           phis(i,nbp_lat)=phisfi_glo(klon_glo)
    … …  
    220228           area(i,1)=areafi_glo(1)/nbp_lon
    221229           area(i,nbp_lat)=areafi_glo(klon_glo)/nbp_lon
    222          enddo
    223          do j=2,nbp_lat-1
     230          enddo
     231          do j=2,nbp_lat-1
    224232           ig0= 1+(j-2)*nbp_lon
    225233           do i=1,nbp_lon
    … …  
    230238           phis(nbp_lon+1,j)=phis(1,j)
    231239           area(nbp_lon+1,j)=area(1,j)
    232          enddo
     240          enddo
     241         ENDIF
    233242         
    234243         ! write "header" of file (longitudes, latitudes, geopotential, ...)
    235          call iniwrite(nid,day_ini,phis,area)
     244         IF (klon_glo>1) THEN ! general 3D case
     245           call iniwrite(nid,day_ini,phis,area,nbp_lon+1,nbp_lat)
     246         ELSE ! 1D model
     247           call iniwrite(nid,day_ini,phisfi_glo(1),areafi_glo(1),1,1)
     248         ENDIF
    236249
    237250         endif ! of if (is_master)
    … …  
    248261      endif ! if (firstnom.eq.'1234567890')
    249262
    250       if (ngrid.eq.1) then
     263      if (klon_glo.eq.1) then
    251264        ! in testphys1d, for the 1d version of the GCM, iphysiq and irythme
    252265        ! are undefined; so set them to 1
    253266        iphysiq=1
    254267        irythme=1
    255         ! NB:
    256268      endif
    257269
    … …  
    320332!         Passage variable physique -->  variable dynamique
    321333!         recast (copy) variable from physics grid to dynamics grid
     334          IF (klon_glo>1) THEN ! General case
    322335           DO l=1,nbp_lev
    323336             DO i=1,nbp_lon+1
    … …  
    333346             ENDDO
    334347           ENDDO
     348          ELSE ! 1D model case
     349           dx3_1d(1,1:nbp_lev)=px(1,1:nbp_lev)
     350          ENDIF
    335351#endif
    336352!         Ecriture du champs
    … …  
    360376           corner(4)=ntime
    361377
    362            edges(1)=nbp_lon+1
     378           IF (klon_glo==1) THEN
     379             edges(1)=1
     380           ELSE
     381             edges(1)=nbp_lon+1
     382           ENDIF
    363383           edges(2)=nbp_lat
    364384           edges(3)=nbp_lev
    … …  
    371391!           write(*,*)"       edges()=",edges
    372392!           write(*,*)"       dx3()=",dx3
    373            ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3)
     393           IF (klon_glo>1) THEN ! General case
     394             ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3)
     395           ELSE
     396             ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3_1d)
     397           ENDIF
    374398!#endif
    375399
    376400           if (ierr.ne.NF_NOERR) then
    377401              write(*,*) "***** PUT_VAR problem in writediagfi"
    378               write(*,*) "***** with ",nom
     402              write(*,*) "***** with dx3: ",nom
    379403              write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr)
    380 c             call abort
     404              stop
    381405           endif
    382406
    … …  
    405429!         Passage variable physique -->  physique dynamique
    406430!         recast (copy) variable from physics grid to dynamics grid
    407 
     431          IF (klon_glo>1) THEN ! General case
    408432             DO i=1,nbp_lon+1
    409433                dx2(i,1)=px(1,1)
    … …  
    417441                dx2(nbp_lon+1,j)=dx2(1,j)
    418442             ENDDO
     443          ELSE ! 1D model case
     444            dx2_1d=px(1,1)
     445          ENDIF
    419446#endif
    420447
    … …  
    442469           corner(2)=1
    443470           corner(3)=ntime
    444            edges(1)=nbp_lon+1
     471           IF (klon_glo==1) THEN
     472             edges(1)=1
     473           ELSE
     474             edges(1)=nbp_lon+1
     475           ENDIF
    445476           edges(2)=nbp_lat
    446477           edges(3)=1
    … …  
    450481!           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx2)
    451482!#else         
    452            ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx2)
     483           IF (klon_glo>1) THEN ! General case
     484             ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx2)
     485           ELSE
     486             ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx2_1d)
     487           ENDIF
    453488!#endif     
    454489
    455490           if (ierr.ne.NF_NOERR) then
    456491              write(*,*) "***** PUT_VAR matter in writediagfi"
    457               write(*,*) "***** with ",nom
     492              write(*,*) "***** with dx2: ",nom
    458493              write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr)
    459 c             call abort
     494              stop
    460495           endif
    461496
    … …  
    505540           if (ierr.ne.NF_NOERR) then
    506541              write(*,*) "***** PUT_VAR problem in writediagfi"
    507               write(*,*) "***** with ",nom
     542              write(*,*) "***** with dx1: ",nom
    508543              write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr)
    509 c             call abort
     544              stop
    510545           endif
    511546
    … …  
    543578           if (ierr.ne.NF_NOERR) then
    544579              write(*,*) "***** PUT_VAR matter in writediagfi"
    545               write(*,*) "***** with ",nom
     580              write(*,*) "***** with dx0: ",nom
    546581              write(*,*) 'ierr=', ierr,": ",NF_STRERROR(ierr)
    547 c             call abort
     582              stop
    548583           endif
    549584
    … …  
    558593      endif
    559594
    560 #endif
    561595      end

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

    r1528 r1532  
    3636real*4,dimension(nbp_lon+1,nbp_lat) :: data2 ! to store 2D data
    3737real*4 :: data0 ! to store 0D data
     38real*4 :: data3_1d(1,nsoilmx) ! to store a profile in 1D model
     39real*4 :: data2_1d ! to store surface value with 1D model
    3840integer :: i,j,l ! for loops
    3941integer :: ig0
    … …  
    5153character(len=20),save :: firstname="1234567890"
    5254integer,save :: zitau=0
     55!$OMP THREADPRIVATE(date,isample,ntime,firstname,zitau)
    5356
    5457character(len=30) :: filename="diagsoil.nc"
    … …  
    107110
    108111   ! build inertia() and area()
    109    do i=1,nbp_lon+1 ! poles
     112   if (klon_glo>1) then
     113    do i=1,nbp_lon+1 ! poles
    110114     inertia(i,1,1:nsoilmx)=inertiafi_glo(1,1:nsoilmx)
    111115     inertia(i,nbp_lat,1:nsoilmx)=inertiafi_glo(klon_glo,1:nsoilmx)
    … …  
    113117     area(i,1)=areafi_glo(1)/nbp_lon
    114118     area(i,nbp_lat)=areafi_glo(klon_glo)/nbp_lon
    115    enddo
    116    do j=2,nbp_lat-1
     119    enddo
     120    do j=2,nbp_lat-1
    117121     ig0= 1+(j-2)*nbp_lon
    118122     do i=1,nbp_lon
    … …  
    123127     inertia(nbp_lon+1,j,1:nsoilmx)=inertia(1,j,1:nsoilmx)
    124128     area(nbp_lon+1,j)=area(1,j)
    125    enddo
     129    enddo
     130   endif
    126131   
    127132   ! write "header" of file (longitudes, latitudes, geopotential, ...)
    128    call iniwritesoil(nid,ngrid,inertia,area)
     133   if (klon_glo>1) then ! general 3D case
     134     call iniwritesoil(nid,ngrid,inertia,area,nbp_lon+1,nbp_lat)
     135   else ! 1D model
     136     call iniwritesoil(nid,ngrid,inertiafi_glo(1,:),areafi_glo(1),1,1)
     137   endif
    129138
    130139  endif ! of if (is_master)
    … …  
    188197!$OMP BARRIER
    189198#else
    190   do l=1,nsoilmx
     199  if (klon_glo>1) then ! General case
     200   do l=1,nsoilmx
    191201    ! handle the poles
    192202    do i=1,nbp_lon+1
    … …  
    202212      data3(nbp_lon+1,j,l)=data3(1,j,l) ! extra (modulo) longitude
    203213    enddo
    204   enddo
     214   enddo
     215  else ! 1D model case
     216   data3_1d(1,1:nsoilmx)=px(1,1:nsoilmx)
     217  endif
    205218#endif
    206219 
    … …  
    229242  corners(4)=ntime
    230243 
    231   edges(1)=nbp_lon+1
     244  if (klon_glo==1) then
     245    edges(1)=1
     246  else
     247    edges(1)=nbp_lon+1
     248  endif
    232249  edges(2)=nbp_lat
    233250  edges(3)=nsoilmx
    … …  
    238255!  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data3)
    239256!#else
    240   ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data3)
     257  if (klon_glo>1) then
     258    ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data3)
     259  else
     260    ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data3_1d)
     261  endif
    241262!#endif
    242263  if (ierr.ne.NF_NOERR) then
    … …  
    263284!$OMP BARRIER
    264285#else
    265   ! handle the poles
    266   do i=1,nbp_lon+1
    267     data2(i,1)=px(1,1)
    268     data2(i,nbp_lat)=px(ngrid,1)
    269   enddo
    270   ! rest of the grid
    271   do j=2,nbp_lat-1
    272     ig0=1+(j-2)*nbp_lon
    273     do i=1,nbp_lon
    274       data2(i,j)=px(ig0+i,1)
    275     enddo
    276     data2(nbp_lon+1,j)=data2(1,j) ! extra (modulo) longitude
    277   enddo
     286  if (klon_glo>1) then ! general case
     287    ! handle the poles
     288    do i=1,nbp_lon+1
     289      data2(i,1)=px(1,1)
     290      data2(i,nbp_lat)=px(ngrid,1)
     291    enddo
     292    ! rest of the grid
     293    do j=2,nbp_lat-1
     294      ig0=1+(j-2)*nbp_lon
     295      do i=1,nbp_lon
     296        data2(i,j)=px(ig0+i,1)
     297      enddo
     298      data2(nbp_lon+1,j)=data2(1,j) ! extra (modulo) longitude
     299    enddo
     300  else ! 1D model case
     301    data2_1d=px(1,1)
     302  endif
    278303#endif
    279304
    … …  
    300325  corners(3)=ntime
    301326 
    302   edges(1)=nbp_lon+1
     327  if (klon_glo==1) then
     328    edges(1)=1
     329  else
     330    edges(1)=nbp_lon+1
     331  endif
    303332  edges(2)=nbp_lat
    304333  edges(3)=1
    … …  
    308337!  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data2)
    309338!#else
    310   ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data2)
     339  if (klon_glo>1) then ! General case
     340    ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data2)
     341  else
     342    ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data2_1d)
     343  endif
    311344!#endif
    312345  if (ierr.ne.NF_NOERR) then

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

    r1528 r1532  
    11subroutine wstats(ngrid,nom,titre,unite,dim,px)
    22
     3use statto_mod, only: istats,istime,count
    34use mod_phys_lmdz_para, only : is_mpi_root, is_master, gather, klon_mpi_begin
    45use mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo, &
    … …  
    67implicit none
    78
    8 include "statto.h"
    99include "netcdf.inc"
    1010
    … …  
    1313integer,intent(in) :: dim
    1414real,intent(in) :: px(ngrid,nbp_lev)
    15 real, dimension(nbp_lon+1,nbp_lat,nbp_lev) :: mean3d,sd3d,dx3
    16 real, dimension(nbp_lon+1,nbp_lat) :: mean2d,sd2d,dx2
     15real,allocatable,save :: mean3d(:,:,:),sd3d(:,:,:),dx3(:,:,:)
     16real,allocatable,save :: mean2d(:,:),sd2d(:,:),dx2(:,:)
    1717character (len=50) :: namebis
    1818character (len=50), save :: firstvar
     19!$OMP THREADPRIVATE(firstvar)
    1920integer :: ierr,varid,nbdim,nid
    2021integer :: meanid,sdid
    … …  
    2526
    2627integer, save :: step=0
     28!$OMP THREADPRIVATE(firstcall,indx,step)
    2729
    2830! Added to work in parallel mode
    … …  
    4749   firstvar=trim((nom))
    4850   call inistats(ierr)
     51   if (klon_glo>1) then ! general case, 3D GCM
     52     allocate(mean3d(nbp_lon+1,nbp_lat,nbp_lev))
     53     allocate(sd3d(nbp_lon+1,nbp_lat,nbp_lev))
     54     allocate(dx3(nbp_lon+1,nbp_lat,nbp_lev))
     55     allocate(mean2d(nbp_lon+1,nbp_lat))
     56     allocate(sd2d(nbp_lon+1,nbp_lat))
     57     allocate(dx2(nbp_lon+1,nbp_lat))
     58   else ! 1D model
     59     allocate(mean3d(1,1,nbp_lev))
     60     allocate(sd3d(1,1,nbp_lev))
     61     allocate(dx3(1,1,nbp_lev))
     62     allocate(mean2d(1,1))
     63     allocate(sd2d(1,1))
     64     allocate(dx2(1,1))
     65   endif
    4966endif
    5067
    … …  
    192209   if (dim.eq.3) then
    193210      start=(/1,1,1,indx/)
    194       sizes=(/nbp_lon+1,nbp_lat,nbp_lev,1/)
     211      if (klon_glo>1) then !general case
     212        sizes=(/nbp_lon+1,nbp_lat,nbp_lev,1/)
     213      else
     214        sizes=(/1,1,nbp_lev,1/)
     215      endif
    195216      mean3d(:,:,:)=0
    196217      sd3d(:,:,:)=0
    197218   else if (dim.eq.2) then
    198219      start=(/1,1,indx,0/)
    199       sizes=(/nbp_lon+1,nbp_lev,1,0/)
     220      if (klon_glo>1) then !general case
     221        sizes=(/nbp_lon+1,nbp_lev,1,0/)
     222      else
     223        sizes=(/1,1,1,0/)
     224      endif
    200225      mean2d(:,:)=0
    201226      sd2d(:,:)=0
    … …  
    205230   if (dim.eq.3) then
    206231      start=(/1,1,1,indx/)
    207       sizes=(/nbp_lon+1,nbp_lat,nbp_lev,1/)
     232      if (klon_glo>1) then !general case
     233        sizes=(/nbp_lon+1,nbp_lat,nbp_lev,1/)
     234      else ! 1D model case
     235        sizes=(/1,1,nbp_lev,1/)
     236      endif
    208237#ifdef NC_DOUBLE
    209238      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,sizes,mean3d)
    … …  
    214243#endif
    215244      if (ierr.ne.NF_NOERR) then
     245         write (*,*) "wstats error reading :",trim(nom)
    216246         write (*,*) NF_STRERROR(ierr)
    217247         stop ""
    … …  
    220250   else if (dim.eq.2) then
    221251      start=(/1,1,indx,0/)
    222       sizes=(/nbp_lon+1,nbp_lat,1,0/)
     252      if (klon_glo>1) then ! general case
     253        sizes=(/nbp_lon+1,nbp_lat,1,0/)
     254      else
     255        sizes=(/1,1,1,0/)
     256      endif
    223257#ifdef NC_DOUBLE
    224258      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,sizes,mean2d)
    … …  
    229263#endif
    230264      if (ierr.ne.NF_NOERR) then
     265         write (*,*) "wstats error reading :",trim(nom)
    231266         write (*,*) NF_STRERROR(ierr)
    232267         stop ""
    … …  
    240275if (dim.eq.3) then
    241276  dx3(1:nbp_lon,:,:)=px3_glo(:,:,:)
    242   dx3(nbp_lon+1,:,:)=dx3(1,:,:)
     277  IF (klon_glo>1) THEN ! in 3D, add redundant longitude point
     278    dx3(nbp_lon+1,:,:)=dx3(1,:,:)
     279  ENDIF
    243280else ! dim.eq.2
    244281  dx2(1:nbp_lon,:)=px2_glo(:,:)
    245   dx2(nbp_lon+1,:)=dx2(1,:)
     282  IF (klon_glo>1) THEN ! in 3D, add redundant longitude point
     283    dx2(nbp_lon+1,:)=dx2(1,:)
     284  ENDIF
    246285endif
    247286
    … …  
    261300   ierr = NF_PUT_VARA_REAL(nid,sdid,start,sizes,sd3d)
    262301#endif
     302  if (ierr.ne.NF_NOERR) then
     303     write (*,*) "wstats error writing :",trim(nom)
     304     write (*,*) NF_STRERROR(ierr)
     305     stop ""
     306  endif
    263307
    264308else if (dim.eq.2) then
    … …  
    274318   ierr = NF_PUT_VARA_REAL(nid,sdid,start,sizes,sd2d)
    275319#endif
     320  if (ierr.ne.NF_NOERR) then
     321     write (*,*) "wstats error writing :",trim(nom)
     322     write(*,*) "start:",start
     323     write(*,*) "sizes:",sizes
     324     write(*,*) "mean2d:",mean2d
     325     write(*,*) "sd2d:",sd2d
     326     write (*,*) NF_STRERROR(ierr)
     327     stop ""
     328  endif
    276329
    277330endif ! of if (dim.eq.3) elseif (dim.eq.2)
    … …  
    284337!======================================================
    285338subroutine inivar(nid,varid,ngrid,dim,indx,px,ierr)
    286 use mod_grid_phy_lmdz, only : nbp_lon, nbp_lat, nbp_lev
     339use mod_grid_phy_lmdz, only : nbp_lon, nbp_lat, nbp_lev, klon_glo
    287340
    288341implicit none
    … …  
    298351real, dimension(nbp_lon+1,nbp_lat,nbp_lev) :: dx3
    299352real, dimension(nbp_lon+1,nbp_lat) :: dx2
     353real :: dx3_1d(nbp_lev) ! for 1D outputs
     354real :: dx2_1d ! for 1D outputs
    300355
    301356if (dim.eq.3) then
    302357
    303358   start=(/1,1,1,indx/)
    304    sizes=(/nbp_lon+1,nbp_lat,nbp_lev,1/)
     359   if (klon_glo>1) then ! general 3D case
     360     sizes=(/nbp_lon+1,nbp_lat,nbp_lev,1/)
     361   else
     362     sizes=(/1,1,nbp_lev,1/)
     363   endif
    305364
    306365!  Passage variable physique -->  variable dynamique
    307366
    308    DO l=1,nbp_lev
     367   if (klon_glo>1) then ! general case
     368    DO l=1,nbp_lev
    309369      DO i=1,nbp_lon+1
    310370         dx3(i,1,l)=px(1,l)
    … …  
    318378         dx3(nbp_lon+1,j,l)=dx3(1,j,l)
    319379      ENDDO
    320    ENDDO
    321 
    322 #ifdef NC_DOUBLE
    323    ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,sizes,dx3)
    324 #else
    325    ierr = NF_PUT_VARA_REAL(nid,varid,start,sizes,dx3)
    326 #endif
     380    ENDDO
     381   else ! 1D model case
     382     dx3_1d(1:nbp_lev)=px(1,1:nbp_lev)
     383   endif
     384
     385#ifdef NC_DOUBLE
     386   if (klon_glo>1) then
     387     ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,sizes,dx3)
     388   else
     389     ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,sizes,dx3_1d)
     390   endif
     391#else
     392   if (klon_glo>1) then
     393     ierr = NF_PUT_VARA_REAL(nid,varid,start,sizes,dx3)
     394   else
     395     ierr = NF_PUT_VARA_REAL(nid,varid,start,sizes,dx3_1d)
     396   endif
     397#endif
     398  if (ierr.ne.NF_NOERR) then
     399     write (*,*) "inivar error writing variable"
     400     write (*,*) NF_STRERROR(ierr)
     401     stop ""
     402  endif
    327403
    328404else if (dim.eq.2) then
    329405
    330406      start=(/1,1,indx,0/)
    331       sizes=(/nbp_lon+1,nbp_lat,1,0/)
     407      if (klon_glo>1) then ! general 3D case
     408        sizes=(/nbp_lon+1,nbp_lat,1,0/)
     409      else
     410        sizes=(/1,1,1,0/)
     411      endif
    332412
    333413!    Passage variable physique -->  physique dynamique
    334414
     415  if (klon_glo>1) then ! general case
    335416  DO i=1,nbp_lon+1
    336417     dx2(i,1)=px(1,1)
    … …  
    344425     dx2(nbp_lon+1,j)=dx2(1,j)
    345426  ENDDO
    346 
    347 #ifdef NC_DOUBLE
    348    ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,sizes,dx2)
    349 #else
    350    ierr = NF_PUT_VARA_REAL(nid,varid,start,sizes,dx2)
    351 #endif
     427  else ! 1D model case
     428    dx2_1d=px(1,1)
     429  endif
     430 
     431#ifdef NC_DOUBLE
     432   if (klon_glo>1) then
     433     ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,sizes,dx2)
     434   else
     435     ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,sizes,dx2_1d)
     436   endif
     437#else
     438   if (klon_glo>1) then
     439     ierr = NF_PUT_VARA_REAL(nid,varid,start,sizes,dx2)
     440   else
     441     ierr = NF_PUT_VARA_REAL(nid,varid,start,sizes,dx2_1d)
     442   endif
     443#endif
     444  if (ierr.ne.NF_NOERR) then
     445     write (*,*) "inivar error writing variable"
     446     write (*,*) NF_STRERROR(ierr)
     447     stop ""
     448  endif
    352449
    353450endif
Note: See TracChangeset for help on using the changeset viewer.